(*  Title:       Executable Transitive Closures of Finite Relations
    Author:      Christian Sternagel <c.sternagel@gmail.com>
                 René Thiemann       <rene.thiemann@uibk.ac.at>
    Maintainer:  Christian Sternagel and René Thiemann
    License:     LGPL
*)

section \<open>Accessing Values via Keys\<close>

theory RBT_Map_Set_Extension
imports
  "../Collections/ICF/impl/RBTMapImpl"
  "../Collections/ICF/impl/RBTSetImpl"
  "../Matrix/Utility"
begin

text \<open>
  We provide two extensions of the red black tree implementation.

  The first extension provides two convenience methods on sets which are represented by red black
  trees: a check on subsets and the big union operator.

  The second extension is to provide two operations @{term elem_list_to_rm} and @{term
  rm_set_lookup} which can be used to index a set of values via keys. More precisely, given a list
  of values of type @{typ "'v"} and a key function of type @{typ "'v => 'k"}, @{term
  elem_list_to_rm} will generate a map of type @{typ "'k => 'v set"}. Then with @{term
  rs_set_lookup} we can efficiently access all values which match a given key.
\<close>

subsection \<open>Subset and Union\<close>

text \<open>
  For the subset operation @{term "r \<subseteq> s"} we provide two implementations. The first one (@{term
  rs_subset}) traverses over @{term r} and then performs membership tests @{text "\<in> s"}. Its
  complexity is ${\cal O}(|r| \cdot log (|s|))$. The second one (@{term rs_subset_list}) generates
  sorted lists for both @{term r} and @{term s} and then linearly checks the subset condition. Its
  complexity is ${\cal O}(|r| + |s|)$.
\<close>

text \<open>
  As union operator we use the standard fold function. Note that the order of the union is important
  so that new sets are added to the big union.
\<close>

(* perhaps there is a smarter way to use two iterates at the same time, however,
  when writing this theory this feature was not detected in the RBTSetImpl theory *)
definition rs_subset :: "('a :: linorder) rs \<Rightarrow> 'a rs \<Rightarrow> 'a option"
where
  "rs_subset as bs = rs.iteratei
    as
    (\<lambda> maybe. case maybe of None \<Rightarrow> True | Some _ \<Rightarrow> False)
    (\<lambda> a _. if rs.memb a bs then None else Some a)
    None"

lemma rs_subset [simp]:
  "rs_subset as bs = None \<longleftrightarrow> rs.\<alpha> as \<subseteq> rs.\<alpha> bs"
proof -
  let ?abort = "\<lambda> maybe. case maybe of None \<Rightarrow> True | Some _ \<Rightarrow> False"
  let ?I = "\<lambda> aas maybe. maybe = None \<longleftrightarrow> (\<forall> a. a \<in> rs.\<alpha> as - aas \<longrightarrow> a \<in> rs.\<alpha> bs)"
  let ?it = "rs_subset as bs"
  have "?I {} ?it \<or> (\<exists> it \<subseteq> rs.\<alpha> as. it \<noteq> {} \<and> \<not> ?abort ?it \<and> ?I it ?it)"
    unfolding rs_subset_def
    by (rule rs.iteratei_rule_P [where I="?I"]) (auto simp: rs.correct)
  then show ?thesis by auto
qed

definition rs_subset_list :: "('a :: linorder) rs \<Rightarrow> 'a rs \<Rightarrow> 'a option"
where
  "rs_subset_list as bs = sorted_list_subset (rs.to_sorted_list as) (rs.to_sorted_list bs)"

definition rs_Union :: "('q :: linorder) rs list \<Rightarrow> 'q rs"
where
  "rs_Union = foldl rs.union (rs.empty ())"

lemma rs_Union [simp]:
  "rs.\<alpha> (rs_Union qs) = \<Union> (rs.\<alpha> ` set qs)"
proof -
  {
    fix start
    have "rs.\<alpha> (foldl rs.union start qs) = rs.\<alpha> start \<union> \<Union> (rs.\<alpha> ` set qs)"
      by (induct qs arbitrary: start, auto simp: rs.correct)
  } from this[of "rs.empty ()"]
  show ?thesis unfolding rs_Union_def
    by (auto simp: rs.correct)
qed

subsection \<open>Grouping Values via Keys\<close>

text \<open>
  The functions to produce the index (@{term elem_list_to_rm}) and the lookup function (@{term
  rm_set_lookup}) are straight-forward, however it requires some tedious reasoning that they perform
  as they should.
\<close>
fun elem_list_to_rm :: "('d \<Rightarrow> 'k :: linorder) \<Rightarrow> 'd list \<Rightarrow> ('k, 'd list) rm"
where
  "elem_list_to_rm key [] = rm.empty ()" |
  "elem_list_to_rm key (d # ds) =
    (let
      rm = elem_list_to_rm key ds;
      k = key d
    in
      (case rm.\<alpha> rm k of
        None \<Rightarrow> rm.update_dj k [d] rm
      | Some data \<Rightarrow> rm.update k (d # data) rm))"

definition "rm_set_lookup rm = (\<lambda> a. (case rm.\<alpha> rm a of None \<Rightarrow> [] | Some rules \<Rightarrow> rules))"

lemma rm_to_list_empty [simp]:
  "rm.to_list (rm.empty ()) = []"
proof -
  have "map_of (rm.to_list (rm.empty ())) = Map.empty"
    by (simp add: rm.correct)
  moreover have map_of_empty_iff: "\<And>l. map_of l = Map.empty \<longleftrightarrow> l = []"
    by (case_tac l) auto
  ultimately show ?thesis by metis
qed

locale rm_set =
  fixes rm :: "('k :: linorder, 'd list) rm"
    and key :: "'d \<Rightarrow> 'k"
    and data :: "'d set"
  assumes rm_set_lookup: "\<And> k. set (rm_set_lookup rm k) = {d \<in> data. key d = k}"
begin

lemma data_lookup:
  "data = \<Union> {set (rm_set_lookup rm k) | k. True}" (is "_ = ?R")
proof -
  {
    fix d
    assume d: "d \<in> data"
    then have d: "d \<in> {d' \<in> data. key d' = key d}" by auto
    have "d \<in> ?R"
      by (rule UnionI[OF _ d], rule CollectI, rule exI[of _ "key d"], unfold rm_set_lookup[of "key d"], simp)
  }
  moreover
  {
    fix d
    assume "d \<in> ?R"
    from this[unfolded rm_set_lookup]
    have "d \<in> data" by auto
  }
  ultimately show ?thesis by blast
qed

lemma finite_data:
  "finite data"
  unfolding data_lookup
proof
  show "finite {set (rm_set_lookup rm k) | k. True}" (is "finite ?L")
  proof -
    let ?rmset = "rm.\<alpha> rm"
    let ?M = "?rmset ` Map.dom ?rmset"
    let ?N = "((\<lambda> e. set (case e of None \<Rightarrow> [] | Some ds \<Rightarrow> ds)) ` ?M)"
    let ?K = "?N \<union> {{}}"
    from rm.finite[of rm] have fin: "finite ?K" by auto
    show ?thesis
    proof (rule finite_subset[OF _ fin], rule)
      fix ds
      assume "ds \<in> ?L"
      from this[unfolded rm_set_lookup_def]
      obtain fn where ds: "ds = set (case rm.\<alpha> rm fn of None \<Rightarrow> []
          | Some ds \<Rightarrow> ds)" by auto
      show "ds \<in> ?K"
      proof (cases "rm.\<alpha> rm fn")
        case None
        then show ?thesis unfolding ds by auto
      next
        case (Some rules)
        from Some have fn: "fn \<in> Map.dom ?rmset" by auto
        have "ds \<in> ?N"
          unfolding ds
          by (rule, rule refl, rule, rule refl, rule fn)
        then show ?thesis by auto
      qed
    qed
  qed
qed (force simp: rm_set_lookup_def)

end

interpretation elem_list_to_rm: rm_set "elem_list_to_rm key ds" key "set ds"
proof
  fix k
  show "set (rm_set_lookup (elem_list_to_rm key ds) k) = {d \<in> set ds. key d = k}"
  proof (induct ds arbitrary: k)
    case Nil
    then show ?case unfolding rm_set_lookup_def
      by (simp add: rm.correct)
  next
    case (Cons d ds k)
    let ?el = "elem_list_to_rm key"
    let ?l = "\<lambda>k ds. set (rm_set_lookup (?el ds) k)"
    let ?r = "\<lambda>k ds. {d \<in> set ds. key d = k}"
    from Cons have ind:
      "\<And> k. ?l k ds = ?r k ds" by auto
    show "?l k (d # ds) = ?r k (d # ds)"
    proof (cases "rm.\<alpha> (?el ds) (key d)")
      case None
      from None ind[of "key d"] have r: "{da \<in> set ds. key da = key d} = {}"
        unfolding rm_set_lookup_def by auto
      from None have el: "?el (d # ds) = rm.update_dj (key d) [d] (?el ds)"
        by simp
      from None have ndom: "key d \<notin> Map.dom (rm.\<alpha> (?el ds))" by auto
      have r: "?r k (d # ds) = ?r k ds \<inter> {da. key da \<noteq> key d} \<union> {da . key da = k \<and> da = d}" (is "_ = ?r1 \<union> ?r2") using r by auto
      from ndom have l: "?l k (d # ds) =
        set (case (rm.\<alpha> (elem_list_to_rm key ds)(key d \<mapsto> [d])) k of None \<Rightarrow> []
        | Some rules \<Rightarrow> rules)" (is "_ = ?l") unfolding el rm_set_lookup_def
        by (simp add: rm.correct)
      {
        fix da
        assume "da \<in> ?r1 \<union> ?r2"
        then have "da \<in> ?l"
        proof
          assume "da \<in> ?r2"
          then have da: "da = d" and k: "key d = k" by auto
          show ?thesis unfolding da k by auto
        next
          assume "da \<in> ?r1"
          from this[unfolded ind[symmetric] rm_set_lookup_def]
          obtain das where rm: "rm.\<alpha> (?el ds) k = Some das" and da: "da \<in> set das" and k: "key da \<noteq> key d" by (cases "rm.\<alpha> (?el ds) k", auto)
          from ind[of k, unfolded rm_set_lookup_def] rm da k have k: "key d \<noteq> k" by auto
          have rm: "(rm.\<alpha> (elem_list_to_rm key ds)(key d \<mapsto> [d])) k = Some das"
            unfolding rm[symmetric] using k by auto
          show ?thesis unfolding rm using da by auto
        qed
      }
      moreover
      {
        fix da
        assume l: "da \<in> ?l"
        let ?rm = "((rm.\<alpha> (elem_list_to_rm key ds))(key d \<mapsto> [d])) k"
        from l obtain das where rm: "?rm = Some das" and da: "da \<in> set das"
          by (cases ?rm, auto)
        have "da \<in> ?r1 \<union> ?r2"
        proof (cases "k = key d")
          case True
          with rm da have da: "da = d" by auto
          then show ?thesis using True by auto
        next
          case False
          with rm have "rm.\<alpha> (?el ds) k = Some das" by auto
          from ind[of k, unfolded rm_set_lookup_def this] da False
          show ?thesis by auto
        qed
      }
      ultimately have "?l = ?r1 \<union> ?r2" by blast
      then show ?thesis unfolding l r .
    next
      case (Some das)
      from Some ind[of "key d"] have das: "{da \<in> set ds. key da = key d} = set das"
        unfolding rm_set_lookup_def by auto
      from Some have el: "?el (d # ds) = rm.update (key d) (d # das) (?el ds)"
        by simp
      from Some have dom: "key d \<in> Map.dom (rm.\<alpha> (?el ds))" by auto
      from dom have l: "?l k (d # ds) =
        set (case (rm.\<alpha> (elem_list_to_rm key ds)(key d \<mapsto> (d # das))) k of None \<Rightarrow> []
        | Some rules \<Rightarrow> rules)" (is "_ = ?l") unfolding el rm_set_lookup_def
        by (simp add: rm.correct)
      have r: "?r k (d # ds) = ?r k ds \<union> {da. key da = k \<and> da = d}" (is "_ = ?r1 \<union> ?r2")  by auto
      {
        fix da
        assume "da \<in> ?r1 \<union> ?r2"
        then have "da \<in> ?l"
        proof
          assume "da \<in> ?r2"
          then have da: "da = d" and k: "key d = k" by auto
          show ?thesis unfolding da k by auto
        next
          assume "da \<in> ?r1"
          from this[unfolded ind[symmetric] rm_set_lookup_def]
          obtain das' where rm: "rm.\<alpha> (?el ds) k = Some das'" and da: "da \<in> set das'" by (cases "rm.\<alpha> (?el ds) k", auto)
          from ind[of k, unfolded rm_set_lookup_def rm] have das': "set das' = {d \<in> set ds. key d = k}" by auto
          show ?thesis
          proof (cases "k = key d")
            case True
            show ?thesis using das' das da unfolding True by simp
          next
            case False
            then show ?thesis using das' da rm by auto
          qed
        qed
      }
      moreover
      {
        fix da
        assume l: "da \<in> ?l"
        let ?rm = "((rm.\<alpha> (elem_list_to_rm key ds))(key d \<mapsto> d # das)) k"
        from l obtain das' where rm: "?rm = Some das'" and da: "da \<in> set das'"
          by (cases ?rm, auto)
        have "da \<in> ?r1 \<union> ?r2"
        proof (cases "k = key d")
          case True
          with rm da das have da: "da \<in> set (d # das)" by auto
          then have "da = d \<or> da \<in> set das" by auto
          then have k: "key da = k"
          proof
            assume "da = d"
            then show ?thesis using True by simp
          next
            assume "da \<in> set das"
            with das True show ?thesis by auto
          qed
          from da k show ?thesis using das by auto
        next
          case False
          with rm have "rm.\<alpha> (?el ds) k = Some das'" by auto
          from ind[of k, unfolded rm_set_lookup_def this] da False
          show ?thesis by auto
        qed
      }
      ultimately have "?l = ?r1 \<union> ?r2" by blast
      then show ?thesis unfolding l r .
    qed
  qed
qed

end


(*****************************************************************************
 * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
 *                       for the OMG Standard.
 *                       http://www.brucker.ch/projects/hol-testgen/
 *
 * UML_PropertyProfiles.thy ---
 * This file is part of HOL-TestGen.
 *
 * Copyright (c) 2013-2015 Université Paris-Saclay, Univ. Paris-Sud, France
 *               2013-2015 IRT SystemX, France
 *
 * 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 list of conditions and the following disclaimer.
 *
 *     * 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.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * 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
 * OWNER 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.
 ******************************************************************************)

theory UML_PropertyProfiles
imports  UML_Logic
begin

section\<open>Property Profiles for OCL Operators via Isabelle Locales\<close>

text\<open>We use the Isabelle mechanism of a \emph{Locale} to generate the
common lemmas for each type and operator; Locales can be seen as a
functor that takes a local theory and generates a number of theorems.
In our case, we will instantiate later these locales by the local theory
of an operator definition and obtain the common rules for strictness, definedness
propagation, context-passingness and constance in a systematic way.
\<close>

subsection\<open>Property Profiles for Monadic Operators\<close>

locale profile_mono_scheme_defined =
   fixes f :: "('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>,'\<beta>::null)val"
   fixes g
   assumes def_scheme: "(f x) \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> then g (x \<tau>) else invalid \<tau>"
begin
   lemma strict[simp,code_unfold]: " f invalid = invalid"
   by(rule ext, simp add: def_scheme true_def false_def)

   lemma null_strict[simp,code_unfold]: " f null = invalid"
   by(rule ext, simp add: def_scheme true_def false_def)

   lemma cp0 : "f X \<tau> = f (\<lambda> _. X \<tau>) \<tau>"
   by(simp add: def_scheme  cp_defined[symmetric])

   lemma cp[simp,code_unfold] : " cp P \<Longrightarrow> cp (\<lambda>X. f (P X) )"
   by(rule cpI1[of "f"], intro allI, rule cp0, simp_all)

end

locale profile_mono_schemeV =
   fixes f :: "('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>,'\<beta>::null)val"
   fixes g
   assumes def_scheme: "(f x) \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> then g (x \<tau>) else invalid \<tau>"
begin
   lemma strict[simp,code_unfold]: " f invalid = invalid"
   by(rule ext, simp add: def_scheme true_def false_def)

   lemma cp0 : "f X \<tau> = f (\<lambda> _. X \<tau>) \<tau>"
   by(simp add: def_scheme  cp_valid[symmetric])

   lemma cp[simp,code_unfold] : " cp P \<Longrightarrow> cp (\<lambda>X. f (P X) )"
   by(rule cpI1[of "f"], intro allI, rule cp0, simp_all)

end

locale profile_mono\<^sub>d = profile_mono_scheme_defined +
   assumes "\<And> x. x \<noteq> bot \<Longrightarrow> x \<noteq> null \<Longrightarrow> g x \<noteq> bot"
begin

   lemma const[simp,code_unfold] :
          assumes C1 :"const X"
          shows       "const(f X)"
      proof -
        have const_g : "const (\<lambda>\<tau>. g (X \<tau>))"  by(insert C1, auto simp:const_def, metis)
        show ?thesis   by(simp_all add : def_scheme const_ss C1 const_g)
      qed
end

locale profile_mono0 = profile_mono_scheme_defined +
   assumes def_body:  "\<And> x. x \<noteq> bot \<Longrightarrow> x \<noteq> null \<Longrightarrow> g x \<noteq> bot \<and> g x \<noteq> null"

sublocale profile_mono0 < profile_mono\<^sub>d
by(unfold_locales, simp add: def_scheme, simp add: def_body)

context profile_mono0
begin
   lemma def_homo[simp,code_unfold]: "\<delta>(f x) = (\<delta> x)"
   apply(rule ext, rename_tac "\<tau>",subst foundation22[symmetric])
   apply(case_tac "\<not>(\<tau> \<Turnstile> \<delta> x)", simp add:defined_split, elim disjE)
     apply(erule StrongEq_L_subst2_rev, simp,simp)
    apply(erule StrongEq_L_subst2_rev, simp,simp)
   apply(simp)
   apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="\<delta> x"])
     apply(simp_all add:def_scheme)
   apply(simp add: OclValid_def)
   by(auto simp:foundation13 StrongEq_def false_def true_def defined_def bot_fun_def null_fun_def def_body
           split: if_split_asm)

   lemma def_valid_then_def: "\<upsilon>(f x) = (\<delta>(f x))"
   apply(rule ext, rename_tac "\<tau>",subst foundation22[symmetric])
   apply(case_tac "\<not>(\<tau> \<Turnstile> \<delta> x)", simp add:defined_split, elim disjE)
     apply(erule StrongEq_L_subst2_rev, simp,simp)
    apply(erule StrongEq_L_subst2_rev, simp,simp)
   apply simp
   apply(simp_all add:def_scheme)
   apply(simp add: OclValid_def valid_def, subst cp_StrongEq)
   apply(subst (2) cp_defined, simp, simp add: cp_defined[symmetric])
   by(auto simp:foundation13 StrongEq_def false_def true_def defined_def bot_fun_def null_fun_def def_body
           split: if_split_asm)
end

subsection\<open>Property Profiles for Single\<close>

locale profile_single =
   fixes d:: "('\<AA>,'a::null)val \<Rightarrow> '\<AA> Boolean"
   assumes d_strict[simp,code_unfold]: "d invalid = false"
   assumes d_cp0: "d X \<tau> = d (\<lambda> _. X \<tau>) \<tau>"
   assumes d_const[simp,code_unfold]: "const X \<Longrightarrow> const (d X)"

subsection\<open>Property Profiles for Binary Operators\<close>

definition "bin' f g d\<^sub>x d\<^sub>y X Y =
                       (f X Y = (\<lambda> \<tau>. if (d\<^sub>x X) \<tau> = true \<tau> \<and> (d\<^sub>y Y) \<tau> = true \<tau>
                                      then g X Y \<tau>
                                      else invalid \<tau> ))"

definition "bin f g = bin' f (\<lambda>X Y \<tau>. g (X \<tau>) (Y \<tau>))"

lemmas [simp,code_unfold] = bin'_def bin_def

locale profile_bin_scheme =
   fixes d\<^sub>x:: "('\<AA>,'a::null)val \<Rightarrow> '\<AA> Boolean"
   fixes d\<^sub>y:: "('\<AA>,'b::null)val \<Rightarrow> '\<AA> Boolean"
   fixes f::"('\<AA>,'a::null)val \<Rightarrow> ('\<AA>,'b::null)val \<Rightarrow> ('\<AA>,'c::null)val"
   fixes g
   assumes d\<^sub>x' : "profile_single d\<^sub>x"
   assumes d\<^sub>y' : "profile_single d\<^sub>y"
   assumes d\<^sub>x_d\<^sub>y_homo[simp,code_unfold]: "cp (f X) \<Longrightarrow>
                          cp (\<lambda>x. f x Y) \<Longrightarrow>
                          f X invalid = invalid \<Longrightarrow>
                          f invalid Y = invalid \<Longrightarrow>
                          (\<not> (\<tau> \<Turnstile> d\<^sub>x X) \<or> \<not> (\<tau> \<Turnstile> d\<^sub>y Y)) \<Longrightarrow>
                          \<tau> \<Turnstile> (\<delta> f X Y \<triangleq> (d\<^sub>x X and d\<^sub>y Y))"
   assumes def_scheme''[simplified]: "bin f g d\<^sub>x d\<^sub>y X Y"
   assumes 1: "\<tau> \<Turnstile> d\<^sub>x X \<Longrightarrow> \<tau> \<Turnstile> d\<^sub>y Y \<Longrightarrow> \<tau> \<Turnstile> \<delta> f X Y"
begin
      interpretation d\<^sub>x : profile_single d\<^sub>x by (rule d\<^sub>x')
      interpretation d\<^sub>y : profile_single d\<^sub>y by (rule d\<^sub>y')

      lemma strict1[simp,code_unfold]: " f invalid y = invalid"
      by(rule ext, simp add: def_scheme'' true_def false_def)

      lemma strict2[simp,code_unfold]: " f x invalid = invalid"
      by(rule ext, simp add: def_scheme'' true_def false_def)

      lemma cp0 : "f X Y \<tau> = f (\<lambda> _. X \<tau>) (\<lambda> _. Y \<tau>) \<tau>"
      by(simp add: def_scheme'' d\<^sub>x.d_cp0[symmetric] d\<^sub>y.d_cp0[symmetric] cp_defined[symmetric])

      lemma cp[simp,code_unfold] : " cp P \<Longrightarrow> cp Q \<Longrightarrow> cp (\<lambda>X. f (P X) (Q X))"
      by(rule cpI2[of "f"], intro allI, rule cp0, simp_all)

      lemma def_homo[simp,code_unfold]: "\<delta>(f x y) = (d\<^sub>x x and d\<^sub>y y)"
         apply(rule ext, rename_tac "\<tau>",subst foundation22[symmetric])
         apply(case_tac "\<not>(\<tau> \<Turnstile> d\<^sub>x x)", simp)
         apply(case_tac "\<not>(\<tau> \<Turnstile> d\<^sub>y y)", simp)
         apply(simp)
         apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="d\<^sub>x x"])
           apply(simp_all)
         apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="d\<^sub>y y"])
           apply(simp_all add: 1 foundation13)
         done

      lemma def_valid_then_def: "\<upsilon>(f x y) = (\<delta>(f x y))" (* [simp,code_unfold] ? *)
         apply(rule ext, rename_tac "\<tau>")
         apply(simp_all add: valid_def defined_def def_scheme''
                             true_def false_def invalid_def
                             null_def null_fun_def null_option_def bot_fun_def)
         by (metis "1" OclValid_def def_scheme'' foundation16 true_def)

      lemma defined_args_valid: "(\<tau> \<Turnstile> \<delta> (f x y)) = ((\<tau> \<Turnstile> d\<^sub>x x) \<and> (\<tau> \<Turnstile> d\<^sub>y y))"
         by(simp add: foundation10')

      lemma const[simp,code_unfold] :
          assumes C1 :"const X" and C2 : "const Y"
          shows       "const(f X Y)"
      proof -
          have const_g : "const (\<lambda>\<tau>. g (X \<tau>) (Y \<tau>))"
                  by(insert C1 C2, auto simp:const_def, metis)
        show ?thesis
        by(simp_all add : def_scheme'' const_ss C1 C2 const_g)
      qed
end

text\<open>
In our context, we will use Locales as ``Property Profiles'' for OCL operators;
if an operator @{term "f"} is of profile @{term "profile_bin_scheme defined f g"} we know
that it satisfies a number of properties like \<open>strict1\<close> or \<open>strict2\<close>
\ie{} @{term "f invalid y = invalid"} and @{term "f null y = invalid"}.
Since some of the more advanced Locales come with 10 - 15 theorems, property profiles
represent a major structuring mechanism for the OCL library.
\<close>

locale profile_bin_scheme_defined =
   fixes d\<^sub>y:: "('\<AA>,'b::null)val \<Rightarrow> '\<AA> Boolean"
   fixes f::"('\<AA>,'a::null)val \<Rightarrow> ('\<AA>,'b::null)val \<Rightarrow> ('\<AA>,'c::null)val"
   fixes g
   assumes d\<^sub>y : "profile_single d\<^sub>y"
   assumes d\<^sub>y_homo[simp,code_unfold]: "cp (f X) \<Longrightarrow>
                          f X invalid = invalid \<Longrightarrow>
                          \<not> \<tau> \<Turnstile> d\<^sub>y Y \<Longrightarrow>
                          \<tau> \<Turnstile> \<delta> f X Y \<triangleq> (\<delta> X and d\<^sub>y Y)"
   assumes def_scheme'[simplified]: "bin f g defined d\<^sub>y X Y"
   assumes def_body':  "\<And> x y \<tau>. x\<noteq>bot \<Longrightarrow> x\<noteq>null \<Longrightarrow> (d\<^sub>y y) \<tau> = true \<tau> \<Longrightarrow> g x (y \<tau>) \<noteq> bot \<and> g x (y \<tau>) \<noteq> null "
begin
      lemma strict3[simp,code_unfold]: " f null y = invalid"
      by(rule ext, simp add: def_scheme' true_def false_def)
end

sublocale profile_bin_scheme_defined < profile_bin_scheme defined
proof -
      interpret d\<^sub>y : profile_single d\<^sub>y by (rule d\<^sub>y)
 show "profile_bin_scheme defined d\<^sub>y f g"
 apply(unfold_locales)
      apply(simp)+
     apply(subst cp_defined, simp)
    apply(rule const_defined, simp)
   apply(simp add:defined_split, elim disjE)
     apply(erule StrongEq_L_subst2_rev, simp, simp)+
   apply(simp)
  apply(simp add: def_scheme')
 apply(simp add: defined_def OclValid_def false_def true_def
              bot_fun_def null_fun_def def_scheme' split: if_split_asm, rule def_body')
 by(simp add: true_def)+
qed

locale profile_bin\<^sub>d_\<^sub>d =
   fixes f::"('\<AA>,'a::null)val \<Rightarrow> ('\<AA>,'b::null)val \<Rightarrow> ('\<AA>,'c::null)val"
   fixes g
   assumes def_scheme[simplified]: "bin f g defined defined X Y"
   assumes def_body:  "\<And> x y. x\<noteq>bot \<Longrightarrow> x\<noteq>null \<Longrightarrow> y\<noteq>bot \<Longrightarrow> y\<noteq>null \<Longrightarrow>
                               g x y \<noteq> bot \<and> g x y \<noteq> null "
begin
      lemma strict4[simp,code_unfold]: " f x null = invalid"
      by(rule ext, simp add: def_scheme true_def false_def)
end

sublocale profile_bin\<^sub>d_\<^sub>d < profile_bin_scheme_defined defined
 apply(unfold_locales)
      apply(simp)+
     apply(subst cp_defined, simp)+
    apply(rule const_defined, simp)+
   apply(simp add:defined_split, elim disjE)
    apply(erule StrongEq_L_subst2_rev, simp, simp)+
  apply(simp add: def_scheme)
 apply(simp add: defined_def OclValid_def false_def true_def bot_fun_def null_fun_def def_scheme)
 apply(rule def_body, simp_all add: true_def false_def split:if_split_asm)
done

locale profile_bin\<^sub>d_\<^sub>v =
   fixes f::"('\<AA>,'a::null)val \<Rightarrow> ('\<AA>,'b::null)val \<Rightarrow> ('\<AA>,'c::null)val"
   fixes g
   assumes def_scheme[simplified]: "bin f g defined valid X Y"
   assumes def_body:  "\<And> x y. x\<noteq>bot \<Longrightarrow> x\<noteq>null \<Longrightarrow> y\<noteq>bot \<Longrightarrow> g x y \<noteq> bot \<and> g x y \<noteq> null"

sublocale profile_bin\<^sub>d_\<^sub>v < profile_bin_scheme_defined valid
 apply(unfold_locales)
      apply(simp)
     apply(subst cp_valid, simp)
    apply(rule const_valid, simp)
   apply(simp add:foundation18'')
   apply(erule StrongEq_L_subst2_rev, simp, simp)
  apply(simp add: def_scheme)
 by (metis OclValid_def def_body foundation18')

locale profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v =
   fixes f :: "('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>) Boolean"
   assumes def_scheme[simplified]: "bin' f StrongEq valid valid X Y"

sublocale profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v < profile_bin_scheme valid valid f "\<lambda>x y. \<lfloor>\<lfloor>x = y\<rfloor>\<rfloor>"
 apply(unfold_locales)
      apply(simp)
     apply(subst cp_valid, simp)
    apply (simp add: const_valid)
   apply (metis (hide_lams, mono_tags) OclValid_def def_scheme defined5 defined6 defined_and_I foundation1 foundation10' foundation16' foundation18 foundation21 foundation22 foundation9)
  apply(simp add: def_scheme, subst StrongEq_def, simp)
 by (metis OclValid_def def_scheme defined7 foundation16)

context profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v
   begin
      lemma idem[simp,code_unfold]: " f null null = true"
      by(rule ext, simp add: def_scheme true_def false_def)

      (* definedness *)
      lemma defargs: "\<tau> \<Turnstile> f x y \<Longrightarrow> (\<tau> \<Turnstile> \<upsilon> x) \<and> (\<tau> \<Turnstile> \<upsilon> y)"
         by(simp add: def_scheme OclValid_def true_def invalid_def valid_def bot_option_def
               split: bool.split_asm HOL.if_split_asm)

      lemma defined_args_valid' : "\<delta> (f x y) = (\<upsilon> x and \<upsilon> y)"
      by(auto intro!: transform2_rev defined_and_I simp:foundation10 defined_args_valid)

      (* logic and algebraic properties *)
      lemma refl_ext[simp,code_unfold] : "(f x x) = (if (\<upsilon> x) then true else invalid endif)"
         by(rule ext, simp add: def_scheme OclIf_def)

      lemma sym : "\<tau> \<Turnstile> (f x y) \<Longrightarrow> \<tau> \<Turnstile> (f y x)"
         apply(case_tac "\<tau> \<Turnstile> \<upsilon> x")
          apply(auto simp: def_scheme OclValid_def)
         by(fold OclValid_def, erule StrongEq_L_sym)

      lemma symmetric : "(f x y) = (f y x)"
         by(rule ext, rename_tac \<tau>, auto simp: def_scheme StrongEq_sym)

      lemma trans : "\<tau> \<Turnstile> (f x y) \<Longrightarrow> \<tau> \<Turnstile> (f y z) \<Longrightarrow> \<tau> \<Turnstile> (f x z)"
         apply(case_tac "\<tau> \<Turnstile> \<upsilon> x")
          apply(case_tac "\<tau> \<Turnstile> \<upsilon> y")
           apply(auto simp: def_scheme OclValid_def)
         by(fold OclValid_def, auto elim: StrongEq_L_trans)

      lemma StrictRefEq_vs_StrongEq: "\<tau> \<Turnstile>(\<upsilon> x) \<Longrightarrow> \<tau> \<Turnstile>(\<upsilon> y) \<Longrightarrow> (\<tau> \<Turnstile> ((f x y) \<triangleq> (x \<triangleq> y)))"
         apply(simp add: def_scheme OclValid_def)
         apply(subst cp_StrongEq[of _ "(x \<triangleq> y)"])
         by simp

   end

locale profile_bin\<^sub>v_\<^sub>v =
   fixes f :: "('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>,'\<beta>::null)val \<Rightarrow> ('\<AA>,'\<gamma>::null)val"
   fixes g
   assumes def_scheme[simplified]: "bin f g valid valid X Y"
   assumes def_body:  "\<And> x y. x\<noteq>bot \<Longrightarrow> y\<noteq>bot \<Longrightarrow> g x y \<noteq> bot \<and> g x y \<noteq> null"

sublocale profile_bin\<^sub>v_\<^sub>v < profile_bin_scheme valid valid
 apply(unfold_locales)
         apply(simp, subst cp_valid, simp, rule const_valid, simp)+
   apply (metis (hide_lams, mono_tags) OclValid_def def_scheme defined5 defined6 defined_and_I
         foundation1 foundation10' foundation16' foundation18 foundation21 foundation22 foundation9)
  apply(simp add: def_scheme)
 apply(simp add: defined_def OclValid_def false_def true_def
              bot_fun_def null_fun_def def_scheme split: if_split_asm, rule def_body)
 by (metis OclValid_def foundation18' true_def)+

end


theory ProcCVars
  imports WTLemma ResMapValid DerefVars
begin

    (* #### we use this to define the full dominator *)

definition dom_use_env where
  "dom_use_env s = (\<lambda> x. if x \<in> s then OwnPerm else NoPerm)"

definition np_dom_use_env where
  "np_dom_use_env env e = dom_use_env (non_prim_vars env e)"

definition full_dom_use_env where
  "full_dom_use_env env rs_map e = dom_use_env (complete_vars rs_map (non_prim_vars env e))"

lemma strong_dom_use_env: "strong_use_env (dom_use_env s)"
  apply (simp add: strong_use_env_def)
  apply (simp add: dom_use_env_def)
  done

lemma dist_dom_leq_use_env: "\<lbrakk> s \<subseteq> s' \<rbrakk> \<Longrightarrow> leq_use_env (dom_use_env s) (dom_use_env s')"
  apply (simp add: dom_use_env_def)
  apply (simp add: leq_use_env_def)
  apply (auto)
  done

lemma full_dom_leq_use_env: "leq_use_env (np_dom_use_env env e) (full_dom_use_env env rs_map e)"
  apply (simp add: np_dom_use_env_def)
  apply (simp add: full_dom_use_env_def)
  apply (rule_tac dist_dom_leq_use_env)
  apply (auto)
  apply (rule_tac x="Nil" in exI)
  apply (auto)
  done

lemma wt_np_leq_use_env: "\<lbrakk> well_typed env r_s1 e tau r_s2 rx; is_own r \<rbrakk> \<Longrightarrow> leq_use_env (np_dom_use_env env e) (lift_use_env r_s1 r)"
  apply (simp add: leq_use_env_def)
  apply (simp add: np_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (auto)
  apply (simp add: is_own_def)
  apply (case_tac "r_s1 x = NoPerm")
   apply (cut_tac env="env" and ?r_s1.0="r_s1" and e="e" and x="x" in well_typed_no_npv_use)
     apply (auto)
  done

end


theory NotAutomat

imports automaton.dAutomaton_causal inNotData outNotData

begin

(*State datatype*)
datatype S_not = Single

instance S_not::countable
  by(countable_datatype)

(*Not automaton*)
fun dAnot_transition::"S_not \<Rightarrow> (bool option) \<Rightarrow> (S_not \<times> bool option)"where
"dAnot_transition S (Some bool) = (S,(Some (\<not>bool)))" |
"dAnot_transition S (None) = (S,(Some True))"

interpretation not_smap:smapGen "dAnot_transition" Single "buildNotInSBE" "buildNotOutSBE" Single
  apply(unfold_locales)
  using S_not.exhaust by auto

definition "notStrong  \<equiv>  daw2das not_smap.da (notOutSBE.setter (Some True))"

abbreviation notStep::"(S_not \<Rightarrow> (inNot\<^sup>\<Omega> \<rightarrow> outNot\<^sup>\<Omega>))"where
"notStep \<equiv> dawStateSem not_smap.da"

definition notSpf::"(inNot\<^sup>\<Omega> \<rightarrow> outNot\<^sup>\<Omega>)"where
"notSpf = dasSem notStrong"

lemma notingetset_eq:"notInSBE.getterSB\<cdot>(notInSBE.setterSB\<cdot>s) = s"
  by(simp)

lemma notoutgetset_eq:"notOutSBE.getterSB\<cdot> (notOutSBE.setterSB\<cdot>s) = s"
  by(simp)

lemma notstep2smap:"notOutSBE.getterSB\<cdot>(notStep Single\<cdot>(notInSBE.setterSB\<cdot>input)) = (smap not_smap.smapTransition)\<cdot>input"
  by(simp add: not_smap.daut2smap)

lemma "notOutSBE.getterSB\<cdot>(notSpf\<cdot>(notInSBE.setterSB\<cdot>input)) = \<up>(Some True) \<bullet>(smap not_smap.smapTransition)\<cdot>input"
  apply(simp add: notSpf_def dassem_insert dasinitout_well das2daw_trunc_well dawSem_def notStrong_def daw2das_def)
  by (metis (mono_tags, lifting) S_not.exhaust notstep2smap)

lemma not_step_t1:"smap not_smap.smapTransition\<cdot>(\<up>(Some bool) \<bullet> s) = \<up>(Some (\<not>bool)) \<bullet> smap not_smap.smapTransition\<cdot>s"
  by simp

lemma not_step_t2:"smap not_smap.smapTransition\<cdot>(\<up>(None) \<bullet> s) = \<up>(Some True) \<bullet> smap not_smap.smapTransition\<cdot>s"
  by simp

end


(*  Title:      HOL/IOA/Asig.thy
    Author:     Tobias Nipkow & Konrad Slind
    Copyright   1994  TU Muenchen
*)

section {* Action signatures *}

theory Asig
imports Main
begin

type_synonym
  'a signature = "('a set * 'a set * 'a set)"

consts
  "actions" :: "'action signature => 'action set"
  "inputs" :: "'action signature => 'action set"
  "outputs" :: "'action signature => 'action set"
  "internals" :: "'action signature => 'action set"
  externals :: "'action signature => 'action set"

  is_asig       ::"'action signature => bool"
  mk_ext_asig   ::"'action signature => 'action signature"

defs

asig_inputs_def:    "inputs == fst"
asig_outputs_def:   "outputs == (fst o snd)"
asig_internals_def: "internals == (snd o snd)"

actions_def:
   "actions(asig) == (inputs(asig) Un outputs(asig) Un internals(asig))"

externals_def:
   "externals(asig) == (inputs(asig) Un outputs(asig))"

is_asig_def:
  "is_asig(triple) ==
      ((inputs(triple) Int outputs(triple) = {})    &
       (outputs(triple) Int internals(triple) = {}) &
       (inputs(triple) Int internals(triple) = {}))"

mk_ext_asig_def:
  "mk_ext_asig(triple) == (inputs(triple), outputs(triple), {})"

lemmas asig_projections = asig_inputs_def asig_outputs_def asig_internals_def

lemma int_and_ext_is_act: "[| a~:internals(S) ;a~:externals(S)|] ==> a~:actions(S)"
  apply (simp add: externals_def actions_def)
  done

lemma ext_is_act: "[|a:externals(S)|] ==> a:actions(S)"
  apply (simp add: externals_def actions_def)
  done

end


theory Functions_gn_n3
imports "$HETS_LIB/Isabelle/MainHC"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"Ax1\", \"Ax2\", \"Ax3\", \"Ax4\", \"Ax5\", \"Ax6\", \"Ax7\",
     \"Ax8\", \"Ax9\"]"

typedecl ('a1) Seq
typedecl X_Nat

consts
X_all :: "(nat => 'S partial) => ('S => bool) => bool" ("all''/'(_,/ _')" [3,3] 999)
X_concat :: "(nat => 'S partial) * (nat => 'S partial) => nat => 'S partial"
X_empty :: "(nat => 'S partial) => bool" ("empty''/'(_')" [3] 999)
X_even :: "nat => bool" ("even''/'(_')" [3] 999)
X_filter :: "(nat => 'S partial) => ('S => bool) => nat => 'S partial"
X_finite :: "(nat => 'S partial) => bool" ("finite''/'(_')" [3] 999)
X_h :: "(nat => 'S partial) => 'S partial" ("h/'(_')" [3] 999)
X_head :: "(nat => 'S partial) => 'S partial" ("head/'(_')" [3] 999)
X_length :: "(nat => 'S partial) => nat partial" ("length''/'(_')" [3] 999)
X_max :: "nat => nat => nat" ("max''/'(_,/ _')" [3,3] 999)
X_min :: "nat => nat => nat" ("min''/'(_,/ _')" [3,3] 999)
X_odd :: "nat => bool" ("odd''/'(_')" [3] 999)
X_pre :: "nat => nat partial" ("pre/'(_')" [3] 999)
X_suc :: "nat => nat" ("suc/'(_')" [3] 999)
nf :: "(nat => 'S partial) => nat => 'S partial"
tail :: "(nat => 'S partial) => nat => 'S partial"

axioms
Ax1 [rule_format] : "ALL s. head(s) = s 0"

Ax2 [rule_format] : "ALL s. tail s = (% x. s (x + 1))"

Ax3 [rule_format] : "ALL s. head(nf s) = h(s)"

Ax4 [rule_format] :
"ALL P. ALL s. nf (X_filter s P) = X_filter (nf s) P"

Ax5 [rule_format] :
"ALL P. ALL s. head(X_filter s P) =
  resOp (head(s), bool2partial (defOp (s 0) & P (makeTotal (s 0))))"

(*"ALL P.
 ALL s.
 head(X_filter s P) =
 (resOp
  (head(s), bool2partial (defOp (s 0) & P (makeTotal (s 0))))"*)

Ax6 [rule_format] :
"ALL P. ALL s. tail (X_filter s P) = X_filter (tail s) P"

Ax7 [rule_format] :
"ALL r.
 ALL s.
 h(s) = makePartial r =
 (EX X_n.
  s X_n = makePartial r & (ALL m. m < X_n --> ~ defOp (s m)))"

Ax8 [rule_format] :
"ALL s. finite'(s) = (EX X_n. ALL m. m > X_n --> ~ defOp (s m))"

Ax9 [rule_format] : "ALL s. empty'(s) = (ALL X_n. ~ defOp (s X_n))"

Ax10 [rule_format] :
"ALL s.
 ALL t.
 head(X_concat (s, t)) = (if ~ empty'(s) then head(s) else head(t))"

Ax11 [rule_format] :
"ALL s.
 ALL t.
 tail (X_concat (s, t)) =
 (if ~ empty'(s) then X_concat (tail s, t) else tail t)"

declare Ax1[simp]
lemmas Ax5' = Ax5 [simplified]

theorem coinduct: "[|R s t ==> (head(s)=head(t) & (R (tail s) (tail t)));  R s t|] ==> s=t"
apply (rule ext)
apply (induct_tac x)
sorry

theorem restrict1 : "restrictOp (restrictOp a (defOp b)) c = restrictOp (restrictOp a c) (defOp (restrictOp b c))"
apply (case_tac c)
apply (simp add: restrictOp_def)
apply (simp add: restrictOp_def)
done

theorem restrict_trivial_rule[simp]: "b ==> restrictOp t b = t"
apply (simp add: restrictOp_def)
done

theorem restrict_trivial [simp]: "restrictOp t True = t"
apply (simp)
done

theorem restrict_assoc[simp] : "restrictOp a (defOp (restrictOp b c)) = restrictOp (restrictOp a (defOp b)) c"
apply (case_tac c)
apply (simp add: restrictOp_def)
apply (simp add: restrictOp_def noneOp_def defOp.simps)
sorry

theorem restrict_out[simp] : "restrictOp (t b) b = restrictOp (t True) b"
apply (case_tac "b")
apply (simp add: restrictOp_def)
apply (simp add: restrictOp_def)
done

theorem mkpartial_cancel [simp]: "makeTotal(makePartial x) = x"
apply (simp add: makeTotal_def makePartial_def)
done

theorem mkpartial_cancel2 [simp]: "defOp(x) ==> makePartial(makeTotal x) = x"
apply (simp add: makeTotal_def makePartial_def)
apply (case_tac x)
apply (simp)
apply (simp)
done

theorem mkpartial_cancel3 [simp] : "((makePartial x) = (makePartial y)) = (x = y)"
apply (simp add: makePartial_def)
done

theorem defOp_trivial [simp]: "defOp(makePartial x) = True"
apply (simp add: makePartial_def makeTotal_def)
done

(* Some more stuff about removing extraneous restrictions *)

theorem total_restrict2 [simp]:
"(c ==> b) ==> restrictOp (t (makeTotal  (restrictOp a b))) c =
	   restrictOp (t (makeTotal a)) c"
apply (simp add: makeTotal_def restrictOp_def defOp.simps undefinedOp_def)
done

theorem def_restrict [simp]:
"defOp (restrictOp a b) = (defOp a & b)"
apply (simp add:  restrictOp_def defOp.simps undefinedOp_def split: split_if)
done

theorem total_restrict [simp]:
"restrictOp (t (makeTotal  (restrictOp a b))) (defOp (restrictOp a b)) =
	   restrictOp (t (makeTotal a)) (defOp a & b)"
apply simp
done

lemma restrictOp_cong [cong]:
  "b = b' ==> (b' ==> a = a') ==> restrictOp a b = restrictOp a' b'"
  apply (simp add: restrictOp_def defOp.simps undefinedOp_def)
done

theorem defop_filter2[simp]: "((defOp (a 0)) & (P (makeTotal (a 0)))) = defOp(X_filter a P 0)"
apply (simp add: Ax5' bool2partial_def resOp_def)
done

lemma double_defop: "defOp(head(X_filter (X_filter a P) P)) = defOp(head(X_filter a P))"
apply (simp add: Ax5' resOp_def bool2partial_def del: defop_filter2)
apply (rule iffI)
apply (auto)
done

lemma double_defop2: "defOp( X_filter (X_filter a P) P 0) = defOp(X_filter a P 0)"
apply (simp only: Ax1[THEN sym])
apply (rule double_defop)
done

lemma double_filter[simp]: "head(X_filter (X_filter a P) P) = head(X_filter a P)"
(*apply (case_tac "defOp(a 0) & P(makeTotal (a 0))")*)
apply (simp only: Ax5 resOp_def bool2partial_def)
apply (auto)
apply (subst double_defop2)
apply (auto)
done

lemma double_filter2: "X_filter (X_filter a P) P 0 = X_filter a P 0"
apply (simp only: Ax1[THEN sym])
apply (rule double_filter)
done

theorem bisim1 : "(%x y. EX a. (x=X_filter a P) & y=(X_filter (X_filter a P) P)) s t ==> head(s)=head(t) & ((%x y. EX a. (x=X_filter a P) & y=(X_filter (X_filter a P) P)) (tail s) (tail t))"
apply (auto)
apply (simp add: double_filter2)
apply (rule_tac x="tail a" in exI)
apply (simp add: Ax6)
done

theorem filter_double : "ALL P. ALL s. X_filter s P=X_filter (X_filter s P) P"
apply (auto)
apply (rule_tac R="(%x y. EX a. (x=X_filter a P) & y=(X_filter (X_filter a P) P))" in coinduct)
apply (rule conjI)
apply (rule impI)
apply (rule bisim1)
apply (simp)
apply (rule_tac x="s" in exI)
apply (auto)
done

theorem bisim2: "(%x y. EX a. (x=nf(X_filter a P)) & (y=X_filter (nf a) P)) s t ==> head(s)=head(t) & ((%x y. EX a. (x=nf(X_filter a P)) & (y=X_filter (nf a) P)) (tail s) (tail t))"
apply (auto)
apply (subst Ax1[THEN sym])
apply (subst Ax3)
apply (subst Ax5')
apply (simp add: resOp_def bool2partial_def)
apply (subst Ax7)
apply (simp add: resOp_def bool2partial_def)
apply (frule exE)
sorry

theorem filter_nfcom: "ALL P. ALL s. nf (X_filter s P) = X_filter (nf s) P"
apply (auto)
apply (rule_tac R="(%x y. EX a. (x=nf(X_filter a P)) & (y=X_filter (nf a) P))" in coinduct)
apply (simp add: bisim2)
apply (rule_tac x="s" in exI)
apply (auto)
done

end


(*  File:       Minimax_Rule.thy
    Copyright   2021  Karlsruhe Institute of Technology (KIT)
*)
\<^marker>\<open>creator "Stephan Bohr, Karlsruhe Institute of Technology (KIT)"\<close>
\<^marker>\<open>contributor "Michael Kirsten, Karlsruhe Institute of Technology (KIT)"\<close>

section \<open>Minimax Rule\<close>

theory Minimax_Rule
  imports "Compositional_Structures/Basic_Modules/Minimax_Module"
          "Compositional_Structures/Elect_Composition"
begin

text \<open>
  This is the Minimax voting rule. It elects the alternatives with the highest
  Minimax score.
\<close>

subsection \<open>Definition\<close>

fun minimax_rule :: "'a Electoral_Module" where
  "minimax_rule A p = elector minimax A p"

subsection \<open>Condorcet Consistency Property\<close>

theorem minimax_condorcet: "condorcet_consistency minimax_rule"
proof (unfold minimax_rule.simps)
  show "condorcet_consistency (elector minimax)"
    using minimax_is_dcc dcc_imp_cc_elector
    by metis
qed

end


(*  Title:      Term_Variants.thy
    Author:     Andreas Viktor Hess, DTU
    Author:     Sebastian A. Mödersheim, DTU
    Author:     Achim D. Brucker, University of Exeter
    Author:     Anders Schlichtkrull, DTU
    SPDX-License-Identifier: BSD-3-Clause
*)

section\<open>Term Variants\<close>
theory Term_Variants
  imports Stateful_Protocol_Composition_and_Typing.Intruder_Deduction
begin

fun term_variants where
  "term_variants P (Var x) = [Var x]"
| "term_variants P (Fun f T) = (
  let S = product_lists (map (term_variants P) T)
  in map (Fun f) S@concat (map (\<lambda>g. map (Fun g) S) (P f)))"

inductive term_variants_pred for P where
  term_variants_Var:
  "term_variants_pred P (Var x) (Var x)"
| term_variants_P:
  "\<lbrakk>length T = length S; \<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i); g \<in> set (P f)\<rbrakk>
   \<Longrightarrow> term_variants_pred P (Fun f T) (Fun g S)"
| term_variants_Fun:
  "\<lbrakk>length T = length S; \<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)\<rbrakk>
   \<Longrightarrow> term_variants_pred P (Fun f T) (Fun f S)"

lemma term_variants_pred_inv:
  assumes "term_variants_pred P (Fun f T) (Fun h S)"
  shows "length T = length S"
    and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)"
    and "f \<noteq> h \<Longrightarrow> h \<in> set (P f)"
using assms by (auto elim: term_variants_pred.cases)

lemma term_variants_pred_inv':
  assumes "term_variants_pred P (Fun f T) t"
  shows "is_Fun t"
    and "length T = length (args t)"
    and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (args t ! i)"
    and "f \<noteq> the_Fun t \<Longrightarrow> the_Fun t \<in> set (P f)"
    and "P \<equiv> (\<lambda>_. [])(g := [h]) \<Longrightarrow> f \<noteq> the_Fun t \<Longrightarrow> f = g \<and> the_Fun t = h"
using assms by (auto elim: term_variants_pred.cases)

lemma term_variants_pred_inv'':
  assumes "term_variants_pred P t (Fun f T)"
  shows "is_Fun t"
    and "length T = length (args t)"
    and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (args t ! i) (T ! i)"
    and "f \<noteq> the_Fun t \<Longrightarrow> f \<in> set (P (the_Fun t))"
    and "P \<equiv> (\<lambda>_. [])(g := [h]) \<Longrightarrow> f \<noteq> the_Fun t \<Longrightarrow> f = h \<and> the_Fun t = g"
using assms by (auto elim: term_variants_pred.cases)

lemma term_variants_pred_inv_Var:
  "term_variants_pred P (Var x) t \<longleftrightarrow> t = Var x"
  "term_variants_pred P t (Var x) \<longleftrightarrow> t = Var x"
by (auto intro: term_variants_Var elim: term_variants_pred.cases)

lemma term_variants_pred_inv_const:
  "term_variants_pred P (Fun c []) t \<longleftrightarrow> ((\<exists>g \<in> set (P c). t = Fun g []) \<or> (t = Fun c []))"
by (auto intro: term_variants_P term_variants_Fun elim: term_variants_pred.cases)

lemma term_variants_pred_refl: "term_variants_pred P t t"
by (induct t) (auto intro: term_variants_pred.intros)

lemma term_variants_pred_refl_inv:
  assumes st: "term_variants_pred P s t"
    and P: "\<forall>f. \<forall>g \<in> set (P f). f = g"
  shows "s = t"
  using st P
proof (induction s t rule: term_variants_pred.induct)
  case (term_variants_Var x) thus ?case by blast
next
  case (term_variants_P T S g f)
  hence "T ! i = S ! i" when i: "i < length T" for i using i by blast
  hence "T = S" using term_variants_P.hyps(1) by (simp add: nth_equalityI)
  thus ?case using term_variants_P.prems term_variants_P.hyps(3) by fast
next
  case (term_variants_Fun T S f)
  hence "T ! i = S ! i" when i: "i < length T" for i using i by blast
  hence "T = S" using term_variants_Fun.hyps(1) by (simp add: nth_equalityI)
  thus ?case by fast
qed

lemma term_variants_pred_const:
  assumes "b \<in> set (P a)"
  shows "term_variants_pred P (Fun a []) (Fun b [])"
using term_variants_P[of "[]" "[]"] assms by simp

lemma term_variants_pred_const_cases:
  "P a \<noteq> [] \<Longrightarrow> term_variants_pred P (Fun a []) t \<longleftrightarrow>
                 (t = Fun a [] \<or> (\<exists>b \<in> set (P a). t = Fun b []))"
  "P a = [] \<Longrightarrow> term_variants_pred P (Fun a []) t \<longleftrightarrow> t = Fun a []"
using term_variants_pred_inv_const[of P] by auto

lemma term_variants_pred_param:
  assumes "term_variants_pred P t s"
    and fg: "f = g \<or> g \<in> set (P f)"
  shows "term_variants_pred P (Fun f (S@t#T)) (Fun g (S@s#T))"
proof -
  have 1: "length (S@t#T) = length (S@s#T)" by simp

  have "term_variants_pred P (T ! i) (T ! i)" "term_variants_pred P (S ! i) (S ! i)" for i
    by (metis term_variants_pred_refl)+
  hence 2: "term_variants_pred P ((S@t#T) ! i) ((S@s#T) ! i)" for i
    by (simp add: assms nth_Cons' nth_append)

  show ?thesis by (metis term_variants_Fun[OF 1 2] term_variants_P[OF 1 2] fg)
qed

lemma term_variants_pred_Cons:
  assumes t: "term_variants_pred P t s"
    and T: "term_variants_pred P (Fun f T) (Fun f S)"
    and fg: "f = g \<or> g \<in> set (P f)"
  shows "term_variants_pred P (Fun f (t#T)) (Fun g (s#S))"
proof -
  have 1: "length (t#T) = length (s#S)"
       and "\<And>i. i < length T \<Longrightarrow> term_variants_pred P (T ! i) (S ! i)"
    using term_variants_pred_inv[OF T] by simp_all
  hence 2: "\<And>i. i < length (t#T) \<Longrightarrow> term_variants_pred P ((t#T) ! i) ((s#S) ! i)"
    by (metis t One_nat_def diff_less length_Cons less_Suc_eq less_imp_diff_less nth_Cons'
              zero_less_Suc)

  show ?thesis using 1 2 fg by (auto intro: term_variants_pred.intros)
qed

lemma term_variants_pred_dense:
  fixes P Q::"'a set" and fs gs::"'a list"
  defines "P_fs x \<equiv> if x \<in> P then fs else []"
    and "P_gs x \<equiv> if x \<in> P then gs else []"
    and "Q_fs x \<equiv> if x \<in> Q then fs else []"
  assumes ut: "term_variants_pred P_fs u t"
    and g: "g \<in> Q" "g \<in> set gs"
  shows "\<exists>s. term_variants_pred P_gs u s \<and> term_variants_pred Q_fs s t"
proof -
  define F where "F \<equiv> \<lambda>(P::'a set) (fs::'a list) x. if x \<in> P then fs else []"

  show ?thesis using ut g P_fs_def unfolding P_gs_def Q_fs_def
  proof (induction u t arbitrary: g gs rule: term_variants_pred.induct)
    case (term_variants_Var h x) thus ?case
      by (auto intro: term_variants_pred.term_variants_Var)
  next
    case (term_variants_P T S h' h g gs)
    note hyps = term_variants_P.hyps(1,2,4,5,6,7)
    note IH = term_variants_P.hyps(3)

    have "\<exists>s. term_variants_pred (F P gs) (T ! i) s \<and> term_variants_pred (F Q fs) s (S ! i)"
      when i: "i < length T" for i
      using IH[OF i hyps(4,5,6)] unfolding F_def by presburger
    then obtain U where U:
        "length T = length U" "\<And>i. i < length T \<Longrightarrow> term_variants_pred (F P gs) (T ! i) (U ! i)"
        "length U = length S" "\<And>i. i < length U \<Longrightarrow> term_variants_pred (F Q fs) (U ! i) (S ! i)"
      using hyps(1) Skolem_list_nth[of _ "\<lambda>i s. term_variants_pred (F P gs) (T ! i) s \<and>
                                                term_variants_pred (F Q fs) s (S ! i)"]
      by moura

    show ?case
      using term_variants_pred.term_variants_P[OF U(1,2), of g h]
            term_variants_pred.term_variants_P[OF U(3,4), of h' g]
            hyps(3)[unfolded hyps(6)] hyps(4,5)
      unfolding F_def by force
  next
    case (term_variants_Fun T S h' g gs)
    note hyps = term_variants_Fun.hyps(1,2,4,5,6)
    note IH = term_variants_Fun.hyps(3)

    have "\<exists>s. term_variants_pred (F P gs) (T ! i) s \<and> term_variants_pred (F Q fs) s (S ! i)"
      when i: "i < length T" for i
      using IH[OF i hyps(3,4,5)] unfolding F_def by presburger
    then obtain U where U:
        "length T = length U" "\<And>i. i < length T \<Longrightarrow> term_variants_pred (F P gs) (T ! i) (U ! i)"
        "length U = length S" "\<And>i. i < length U \<Longrightarrow> term_variants_pred (F Q fs) (U ! i) (S ! i)"
      using hyps(1) Skolem_list_nth[of _ "\<lambda>i s. term_variants_pred (F P gs) (T ! i) s \<and>
                                                term_variants_pred (F Q fs) s (S ! i)"]
      by moura

    thus ?case
      using term_variants_pred.term_variants_Fun[OF U(1,2)]
            term_variants_pred.term_variants_Fun[OF U(3,4)]
      unfolding F_def by meson
  qed
qed

lemma term_variants_pred_dense':
  assumes ut: "term_variants_pred ((\<lambda>_. [])(a := [b])) u t"
  shows "\<exists>s. term_variants_pred ((\<lambda>_. [])(a := [c])) u s \<and>
             term_variants_pred ((\<lambda>_. [])(c := [b])) s t"
using ut term_variants_pred_dense[of "{a}" "[b]" u t c "{c}" "[c]"]
unfolding fun_upd_def by simp

lemma term_variants_pred_eq_case:
  fixes t s::"('a,'b) term"
  assumes "term_variants_pred P t s" "\<forall>f \<in> funs_term t. P f = []"
  shows "t = s"
using assms
proof (induction t s rule: term_variants_pred.induct)
  case (term_variants_Fun T S f) thus ?case
    using subtermeq_imp_funs_term_subset[OF Fun_param_in_subterms[OF nth_mem], of _ T f]
          nth_equalityI[of T S]
    by blast
qed (simp_all add: term_variants_pred_refl)

lemma term_variants_pred_subst:
  assumes "term_variants_pred P t s"
  shows "term_variants_pred P (t \<cdot> \<delta>) (s \<cdot> \<delta>)"
using assms
proof (induction t s rule: term_variants_pred.induct)
  case (term_variants_P T S f g)
  have 1: "length (map (\<lambda>t. t \<cdot> \<delta>) T) = length (map (\<lambda>t. t \<cdot> \<delta>) S)"
    using term_variants_P.hyps
    by simp

  have 2: "term_variants_pred P ((map (\<lambda>t. t \<cdot> \<delta>) T) ! i) ((map (\<lambda>t. t \<cdot> \<delta>) S) ! i)"
    when "i < length (map (\<lambda>t. t \<cdot> \<delta>) T)" for i
    using term_variants_P that
    by fastforce

  show ?case
    using term_variants_pred.term_variants_P[OF 1 2 term_variants_P.hyps(3)]
    by fastforce
next
  case (term_variants_Fun T S f)
  have 1: "length (map (\<lambda>t. t \<cdot> \<delta>) T) = length (map (\<lambda>t. t \<cdot> \<delta>) S)"
    using term_variants_Fun.hyps
    by simp

  have 2: "term_variants_pred P ((map (\<lambda>t. t \<cdot> \<delta>) T) ! i) ((map (\<lambda>t. t \<cdot> \<delta>) S) ! i)"
    when "i < length (map (\<lambda>t. t \<cdot> \<delta>) T)" for i
    using term_variants_Fun that
    by fastforce

  show ?case
    using term_variants_pred.term_variants_Fun[OF 1 2]
    by fastforce
qed (simp add: term_variants_pred_refl)

lemma term_variants_pred_subst':
  fixes t s::"('a,'b) term" and \<delta>::"('a,'b) subst"
  assumes "term_variants_pred P (t \<cdot> \<delta>) s"
    and "\<forall>x \<in> fv t \<union> fv s. (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
  shows "\<exists>u. term_variants_pred P t u \<and> s = u \<cdot> \<delta>"
using assms
proof (induction "t \<cdot> \<delta>" s arbitrary: t rule: term_variants_pred.induct)
  case (term_variants_Var x g) thus ?case using term_variants_pred_refl by fast
next
  case (term_variants_P T S g f) show ?case
  proof (cases t)
    case (Var x) thus ?thesis
      using term_variants_P.hyps(4,5) term_variants_P.prems
      by fastforce
  next
    case (Fun h U)
    hence 1: "h = f" "T = map (\<lambda>s. s \<cdot> \<delta>) U" "length U = length T"
      using term_variants_P.hyps(5) by simp_all
    hence 2: "T ! i = U ! i \<cdot> \<delta>" when "i < length T" for i
      using that by simp

    have "\<forall>x \<in> fv (U ! i) \<union> fv (S ! i). (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
      when "i < length U" for i
      using that Fun term_variants_P.prems term_variants_P.hyps(1) 1(3)
      by force
    hence IH: "\<forall>i < length U. \<exists>u. term_variants_pred P (U ! i) u \<and> S ! i = u \<cdot> \<delta>"
      by (metis 1(3) term_variants_P.hyps(3)[OF _ 2])

    have "\<exists>V. length U = length V \<and> S = map (\<lambda>v. v \<cdot> \<delta>) V \<and>
               (\<forall>i < length U. term_variants_pred P (U ! i) (V ! i))"
      using term_variants_P.hyps(1) 1(3) subst_term_list_obtain[OF IH] by metis
    then obtain V where V: "length U = length V" "S = map (\<lambda>v. v \<cdot> \<delta>) V"
                           "\<And>i. i < length U \<Longrightarrow> term_variants_pred P (U ! i) (V ! i)"
      by moura

    have "term_variants_pred P (Fun f U) (Fun g V)"
      by (metis term_variants_pred.term_variants_P[OF V(1,3) term_variants_P.hyps(4)])
    moreover have "Fun g S = Fun g V \<cdot> \<delta>" using V(2) by simp
    ultimately show ?thesis using term_variants_P.hyps(1,4) Fun 1 by blast
  qed
next
  case (term_variants_Fun T S f t) show ?case
  proof (cases t)
    case (Var x)
    hence "T = []" "P f = []" using term_variants_Fun.hyps(4) term_variants_Fun.prems by fastforce+
    thus ?thesis using term_variants_pred_refl Var term_variants_Fun.hyps(1,4) by fastforce
  next
    case (Fun h U)
    hence 1: "h = f" "T = map (\<lambda>s. s \<cdot> \<delta>) U" "length U = length T"
      using term_variants_Fun.hyps(4) by simp_all
    hence 2: "T ! i = U ! i \<cdot> \<delta>" when "i < length T" for i
      using that by simp

    have "\<forall>x \<in> fv (U ! i) \<union> fv (S ! i). (\<exists>y. \<delta> x = Var y) \<or> (\<exists>f. \<delta> x = Fun f [] \<and> P f = [])"
      when "i < length U" for i
      using that Fun term_variants_Fun.prems term_variants_Fun.hyps(1) 1(3)
      by force
    hence IH: "\<forall>i < length U. \<exists>u. term_variants_pred P (U ! i) u \<and> S ! i = u \<cdot> \<delta>"
      by (metis 1(3) term_variants_Fun.hyps(3)[OF _ 2 ])

    have "\<exists>V. length U = length V \<and> S = map (\<lambda>v. v \<cdot> \<delta>) V \<and>
               (\<forall>i < length U. term_variants_pred P (U ! i) (V ! i))"
      using term_variants_Fun.hyps(1) 1(3) subst_term_list_obtain[OF IH] by metis
    then obtain V where V: "length U = length V" "S = map (\<lambda>v. v \<cdot> \<delta>) V"
                           "\<And>i. i < length U \<Longrightarrow> term_variants_pred P (U ! i) (V ! i)"
      by moura

    have "term_variants_pred P (Fun f U) (Fun f V)"
      by (metis term_variants_pred.term_variants_Fun[OF V(1,3)])
    moreover have "Fun f S = Fun f V \<cdot> \<delta>" using V(2) by simp
    ultimately show ?thesis using term_variants_Fun.hyps(1) Fun 1 by blast
  qed
qed

lemma term_variants_pred_subst'':
  assumes "\<forall>x \<in> fv t. term_variants_pred P (\<delta> x) (\<theta> x)"
  shows "term_variants_pred P (t \<cdot> \<delta>) (t \<cdot> \<theta>)"
using assms
proof (induction t)
  case (Fun f ts) thus ?case
    using term_variants_Fun[of "map (\<lambda>t. t \<cdot> \<delta>) ts" "map (\<lambda>t. t \<cdot> \<theta>) ts" P f] by force
qed simp

lemma term_variants_pred_iff_in_term_variants:
  fixes t::"('a,'b) term"
  shows "term_variants_pred P t s \<longleftrightarrow> s \<in> set (term_variants P t)"
    (is "?A t s \<longleftrightarrow> ?B t s")
proof
  define U where "U \<equiv> \<lambda>P (T::('a,'b) term list). product_lists (map (term_variants P) T)"

  have a:
      "g \<in> set (P f) \<Longrightarrow> set (map (Fun g) (U P T)) \<subseteq> set (term_variants P (Fun f T))"
      "set (map (Fun f) (U P T)) \<subseteq> set (term_variants P (Fun f T))"
    for f P g and T::"('a,'b) term list"
    using term_variants.simps(2)[of P f T]
    unfolding U_def Let_def by auto

  have b: "\<exists>S \<in> set (U P T). s = Fun f S \<or> (\<exists>g \<in> set (P f). s = Fun g S)"
    when "s \<in> set (term_variants P (Fun f T))" for P T f s
    using that by (cases "P f") (auto simp add: U_def Let_def)

  have c: "length T = length S" when "S \<in> set (U P T)" for S P T
    using that unfolding U_def
    by (simp add: in_set_product_lists_length)

  show "?A t s \<Longrightarrow> ?B t s"
  proof (induction t s rule: term_variants_pred.induct)
    case (term_variants_P T S g f)
    note hyps = term_variants_P.hyps
    note IH = term_variants_P.IH

    have "S \<in> set (U P T)"
      using IH hyps(1) product_lists_in_set_nth'[of _ S]
      unfolding U_def by simp
    thus ?case using a(1)[of _ P, OF hyps(3)] by auto
  next
    case (term_variants_Fun T S f)
    note hyps = term_variants_Fun.hyps
    note IH = term_variants_Fun.IH

    have "S \<in> set (U P T)"
      using IH hyps(1) product_lists_in_set_nth'[of _ S]
      unfolding U_def by simp
    thus ?case using a(2)[of f P T] by (cases "P f") auto
  qed (simp add: term_variants_Var)

  show "?B t s \<Longrightarrow> ?A t s"
  proof (induction P t arbitrary: s rule: term_variants.induct)
    case (2 P f T)
    obtain S where S:
        "s = Fun f S \<or> (\<exists>g \<in> set (P f). s = Fun g S)"
        "S \<in> set (U P T)" "length T = length S"
      using c b[OF "2.prems"] by moura

    have "\<forall>i < length T. term_variants_pred P (T ! i) (S ! i)"
      using "2.IH" S product_lists_in_set_nth by (fastforce simp add: U_def)
    thus ?case using S by (auto intro: term_variants_pred.intros)
  qed (simp add: term_variants_Var)
qed

lemma term_variants_pred_finite:
  "finite {s. term_variants_pred P t s}"
using term_variants_pred_iff_in_term_variants[of P t]
by simp

lemma term_variants_pred_fv_eq:
  assumes "term_variants_pred P s t"
  shows "fv s = fv t"
using assms
by (induct rule: term_variants_pred.induct)
   (metis, metis fv_eq_FunI, metis fv_eq_FunI)

lemma (in intruder_model) term_variants_pred_wf_trms:
  assumes "term_variants_pred P s t"
    and "\<And>f g. g \<in> set (P f) \<Longrightarrow> arity f = arity g"
    and "wf\<^sub>t\<^sub>r\<^sub>m s"
  shows "wf\<^sub>t\<^sub>r\<^sub>m t"
using assms
apply (induction rule: term_variants_pred.induct, simp)
by (metis (no_types) wf_trmI wf_trm_arity in_set_conv_nth wf_trm_param_idx)+

lemma term_variants_pred_funs_term:
  assumes "term_variants_pred P s t"
    and "f \<in> funs_term t"
  shows "f \<in> funs_term s \<or> (\<exists>g \<in> funs_term s. f \<in> set (P g))"
  using assms
proof (induction rule: term_variants_pred.induct)
  case (term_variants_P T S g h) thus ?case
  proof (cases "f = g")
    case False
    then obtain s where "s \<in> set S" "f \<in> funs_term s"
      using funs_term_subterms_eq(1)[of "Fun g S"] term_variants_P.prems by auto
    thus ?thesis
      using term_variants_P.IH term_variants_P.hyps(1) in_set_conv_nth[of s S] by force
  qed simp
next
  case (term_variants_Fun T S h) thus ?case
  proof (cases "f = h")
    case False
    then obtain s where "s \<in> set S" "f \<in> funs_term s"
      using funs_term_subterms_eq(1)[of "Fun h S"] term_variants_Fun.prems by auto
    thus ?thesis
      using term_variants_Fun.IH term_variants_Fun.hyps(1) in_set_conv_nth[of s S] by force
  qed simp
qed fast

end