theory Examples
imports Main
begin

(*
text {* The following presentation will use notation of
  Isabelle's meta logic, hence a few sentences to explain this.
  The logical
  primitives are universal quantification (@{text "\<And>"}), entailment
  (@{text "\<Longrightarrow>"}) and equality (@{text "\<equiv>"}).  Variables (not bound
  variables) are sometimes preceded by a question mark.  The logic is
  typed.  Type variables are denoted by~@{text "'a"},~@{text "'b"}
  etc., and~@{text "\<Rightarrow>"} is the function type.  Double brackets~@{text
  "\<lbrakk>"} and~@{text "\<rbrakk>"} are used to abbreviate nested entailment.
*}
*)

section \<open>Introduction\<close>

text \<open>
  Locales are based on contexts.  A \emph{context} can be seen as a
  formula schema
\[
  \<open>\<And>x\<^sub>1\<dots>x\<^sub>n. \<lbrakk> A\<^sub>1; \<dots> ;A\<^sub>m \<rbrakk> \<Longrightarrow> \<dots>\<close>
\]
  where the variables~\<open>x\<^sub>1\<close>, \ldots,~\<open>x\<^sub>n\<close> are called
  \emph{parameters} and the premises $\<open>A\<^sub>1\<close>, \ldots,~\<open>A\<^sub>m\<close>$ \emph{assumptions}.  A formula~\<open>C\<close>
  is a \emph{theorem} in the context if it is a conclusion
\[
  \<open>\<And>x\<^sub>1\<dots>x\<^sub>n. \<lbrakk> A\<^sub>1; \<dots> ;A\<^sub>m \<rbrakk> \<Longrightarrow> C\<close>.
\]
  Isabelle/Isar's notion of context goes beyond this logical view.
  Its contexts record, in a consecutive order, proved
  conclusions along with \emph{attributes}, which can provide context
  specific configuration information for proof procedures and concrete
  syntax.  From a logical perspective, locales are just contexts that
  have been made persistent.  To the user, though, they provide
  powerful means for declaring and combining contexts, and for the
  reuse of theorems proved in these contexts.
\<close>

section \<open>Simple Locales\<close>

text \<open>
  In its simplest form, a
  \emph{locale declaration} consists of a sequence of context elements
  declaring parameters (keyword \isakeyword{fixes}) and assumptions
  (keyword \isakeyword{assumes}).  The following is the specification of
  partial orders, as locale \<open>partial_order\<close>.
\<close>

  locale partial_order =
    fixes le :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl "\<sqsubseteq>" 50)
    assumes refl [intro, simp]: "x \<sqsubseteq> x"
      and anti_sym [intro]: "\<lbrakk> x \<sqsubseteq> y; y \<sqsubseteq> x \<rbrakk> \<Longrightarrow> x = y"
      and trans [trans]: "\<lbrakk> x \<sqsubseteq> y; y \<sqsubseteq> z \<rbrakk> \<Longrightarrow> x \<sqsubseteq> z"

text (in partial_order) \<open>The parameter of this locale is~\<open>le\<close>,
  which is a binary predicate with infix syntax~\<open>\<sqsubseteq>\<close>.  The
  parameter syntax is available in the subsequent
  assumptions, which are the familiar partial order axioms.

  Isabelle recognises unbound names as free variables.  In locale
  assumptions, these are implicitly universally quantified.  That is,
  \<^term>\<open>\<lbrakk> x \<sqsubseteq> y; y \<sqsubseteq> z \<rbrakk> \<Longrightarrow> x \<sqsubseteq> z\<close> in fact means
  \<^term>\<open>\<And>x y z. \<lbrakk> x \<sqsubseteq> y; y \<sqsubseteq> z \<rbrakk> \<Longrightarrow> x \<sqsubseteq> z\<close>.

  Two commands are provided to inspect locales:
  \isakeyword{print\_locales} lists the names of all locales of the
  current theory; \isakeyword{print\_locale}~$n$ prints the parameters
  and assumptions of locale $n$; the variation \isakeyword{print\_locale!}~$n$
  additionally outputs the conclusions that are stored in the locale.
  We may inspect the new locale
  by issuing \isakeyword{print\_locale!} \<^term>\<open>partial_order\<close>.  The output
  is the following list of context elements.
\begin{small}
\begin{alltt}
  \isakeyword{fixes} le :: "'a \(\Rightarrow\) 'a \(\Rightarrow\)  bool" (\isakeyword{infixl} "\(\sqsubseteq\)" 50)
  \isakeyword{assumes} "partial_order (\(\sqsubseteq\))"
  \isakeyword{notes} assumption
    refl [intro, simp] = `?x \(\sqsubseteq\) ?x`
    \isakeyword{and}
    anti_sym [intro] = `\(\isasymlbrakk\)?x \(\sqsubseteq\) ?y; ?y \(\sqsubseteq\) ?x\(\isasymrbrakk\) \(\Longrightarrow\) ?x = ?y`
    \isakeyword{and}
    trans [trans] = `\(\isasymlbrakk\)?x \(\sqsubseteq\) ?y; ?y \(\sqsubseteq\) ?z\(\isasymrbrakk\) \(\Longrightarrow\) ?x \(\sqsubseteq\) ?z`
\end{alltt}
\end{small}

  This differs from the declaration.  The assumptions have turned into
  conclusions, denoted by the keyword \isakeyword{notes}.  Also,
  there is only one assumption, namely \<^term>\<open>partial_order le\<close>.
  The locale declaration has introduced the predicate \<^term>\<open>partial_order\<close> to the theory.  This predicate is the
  \emph{locale predicate}.  Its definition may be inspected by
  issuing \isakeyword{thm} @{thm [source] partial_order_def}.
  @{thm [display, indent=2] partial_order_def}
  In our example, this is a unary predicate over the parameter of the
  locale.  It is equivalent to the original assumptions, which have
  been turned into conclusions and are
  available as theorems in the context of the locale.  The names and
  attributes from the locale declaration are associated to these
  theorems and are effective in the context of the locale.

  Each conclusion has a \emph{foundational theorem} as counterpart
  in the theory.  Technically, this is simply the theorem composed
  of context and conclusion.  For the transitivity theorem, this is
  @{thm [source] partial_order.trans}:
  @{thm [display, indent=2] partial_order.trans}
\<close>

subsection \<open>Targets: Extending Locales\<close>

text \<open>
  The specification of a locale is fixed, but its list of conclusions
  may be extended through Isar commands that take a \emph{target} argument.
  In the following, \isakeyword{definition} and
  \isakeyword{theorem} are illustrated.
  Table~\ref{tab:commands-with-target} lists Isar commands that accept
  a target.  Isar provides various ways of specifying the target.  A
  target for a single command may be indicated with keyword
  \isakeyword{in} in the following way:

\begin{table}
\hrule
\vspace{2ex}
\begin{center}
\begin{tabular}{ll}
  \isakeyword{definition} & definition through an equation \\
  \isakeyword{inductive} & inductive definition \\
  \isakeyword{primrec} & primitive recursion \\
  \isakeyword{fun}, \isakeyword{function} & general recursion \\
  \isakeyword{abbreviation} & syntactic abbreviation \\
  \isakeyword{theorem}, etc.\ & theorem statement with proof \\
  \isakeyword{theorems}, etc.\ & redeclaration of theorems \\
  \isakeyword{text}, etc.\ & document markup
\end{tabular}
\end{center}
\hrule
\caption{Isar commands that accept a target.}
\label{tab:commands-with-target}
\end{table}
\<close>

  definition (in partial_order)
    less :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infixl "\<sqsubset>" 50)
    where "(x \<sqsubset> y) = (x \<sqsubseteq> y \<and> x \<noteq> y)"

text (in partial_order) \<open>The strict order \<open>less\<close> with infix
  syntax~\<open>\<sqsubset>\<close> is
  defined in terms of the locale parameter~\<open>le\<close> and the general
  equality of the object logic we work in.  The definition generates a
  \emph{foundational constant}
  \<^term>\<open>partial_order.less\<close> with definition @{thm [source]
  partial_order.less_def}:
  @{thm [display, indent=2] partial_order.less_def}
  At the same time, the locale is extended by syntax transformations
  hiding this construction in the context of the locale.  Here, the
  abbreviation \<open>less\<close> is available for
  \<open>partial_order.less le\<close>, and it is printed
  and parsed as infix~\<open>\<sqsubset>\<close>.  Finally, the conclusion @{thm [source]
  less_def} is added to the locale:
  @{thm [display, indent=2] less_def}
\<close>

text \<open>The treatment of theorem statements is more straightforward.
  As an example, here is the derivation of a transitivity law for the
  strict order relation.\<close>

  lemma (in partial_order) less_le_trans [trans]:
    "\<lbrakk> x \<sqsubset> y; y \<sqsubseteq> z \<rbrakk> \<Longrightarrow> x \<sqsubset> z"
    unfolding %visible less_def by %visible (blast intro: trans)

text \<open>In the context of the proof, conclusions of the
  locale may be used like theorems.  Attributes are effective: \<open>anti_sym\<close> was
  declared as introduction rule, hence it is in the context's set of
  rules used by the classical reasoner by default.\<close>

subsection \<open>Context Blocks\<close>

text \<open>When working with locales, sequences of commands with the same
  target are frequent.  A block of commands, delimited by
  \isakeyword{begin} and \isakeyword{end}, makes a theory-like style
  of working possible.  All commands inside the block refer to the
  same target.  A block may immediately follow a locale
  declaration, which makes that locale the target.  Alternatively the
  target for a block may be given with the \isakeyword{context}
  command.

  This style of working is illustrated in the block below, where
  notions of infimum and supremum for partial orders are introduced,
  together with theorems about their uniqueness.\<close>

  context partial_order
  begin

  definition
    is_inf where "is_inf x y i =
      (i \<sqsubseteq> x \<and> i \<sqsubseteq> y \<and> (\<forall>z. z \<sqsubseteq> x \<and> z \<sqsubseteq> y \<longrightarrow> z \<sqsubseteq> i))"

  definition
    is_sup where "is_sup x y s =
      (x \<sqsubseteq> s \<and> y \<sqsubseteq> s \<and> (\<forall>z. x \<sqsubseteq> z \<and> y \<sqsubseteq> z \<longrightarrow> s \<sqsubseteq> z))"

  lemma %invisible is_infI [intro?]: "i \<sqsubseteq> x \<Longrightarrow> i \<sqsubseteq> y \<Longrightarrow>
      (\<And>z. z \<sqsubseteq> x \<Longrightarrow> z \<sqsubseteq> y \<Longrightarrow> z \<sqsubseteq> i) \<Longrightarrow> is_inf x y i"
    by (unfold is_inf_def) blast

  lemma %invisible is_inf_lower [elim?]:
    "is_inf x y i \<Longrightarrow> (i \<sqsubseteq> x \<Longrightarrow> i \<sqsubseteq> y \<Longrightarrow> C) \<Longrightarrow> C"
    by (unfold is_inf_def) blast

  lemma %invisible is_inf_greatest [elim?]:
      "is_inf x y i \<Longrightarrow> z \<sqsubseteq> x \<Longrightarrow> z \<sqsubseteq> y \<Longrightarrow> z \<sqsubseteq> i"
    by (unfold is_inf_def) blast

  theorem is_inf_uniq: "\<lbrakk>is_inf x y i; is_inf x y i'\<rbrakk> \<Longrightarrow> i = i'"
    proof -
    assume inf: "is_inf x y i"
    assume inf': "is_inf x y i'"
    show ?thesis
    proof (rule anti_sym)
      from inf' show "i \<sqsubseteq> i'"
      proof (rule is_inf_greatest)
        from inf show "i \<sqsubseteq> x" ..
        from inf show "i \<sqsubseteq> y" ..
      qed
      from inf show "i' \<sqsubseteq> i"
      proof (rule is_inf_greatest)
        from inf' show "i' \<sqsubseteq> x" ..
        from inf' show "i' \<sqsubseteq> y" ..
      qed
    qed
  qed

  theorem %invisible is_inf_related [elim?]: "x \<sqsubseteq> y \<Longrightarrow> is_inf x y x"
  proof -
    assume "x \<sqsubseteq> y"
    show ?thesis
    proof
      show "x \<sqsubseteq> x" ..
      show "x \<sqsubseteq> y" by fact
      fix z assume "z \<sqsubseteq> x" and "z \<sqsubseteq> y" show "z \<sqsubseteq> x" by fact
    qed
  qed

  lemma %invisible is_supI [intro?]: "x \<sqsubseteq> s \<Longrightarrow> y \<sqsubseteq> s \<Longrightarrow>
      (\<And>z. x \<sqsubseteq> z \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> s \<sqsubseteq> z) \<Longrightarrow> is_sup x y s"
    by (unfold is_sup_def) blast

  lemma %invisible is_sup_least [elim?]:
      "is_sup x y s \<Longrightarrow> x \<sqsubseteq> z \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> s \<sqsubseteq> z"
    by (unfold is_sup_def) blast

  lemma %invisible is_sup_upper [elim?]:
      "is_sup x y s \<Longrightarrow> (x \<sqsubseteq> s \<Longrightarrow> y \<sqsubseteq> s \<Longrightarrow> C) \<Longrightarrow> C"
    by (unfold is_sup_def) blast

  theorem is_sup_uniq: "\<lbrakk>is_sup x y s; is_sup x y s'\<rbrakk> \<Longrightarrow> s = s'"
    proof -
    assume sup: "is_sup x y s"
    assume sup': "is_sup x y s'"
    show ?thesis
    proof (rule anti_sym)
      from sup show "s \<sqsubseteq> s'"
      proof (rule is_sup_least)
        from sup' show "x \<sqsubseteq> s'" ..
        from sup' show "y \<sqsubseteq> s'" ..
      qed
      from sup' show "s' \<sqsubseteq> s"
      proof (rule is_sup_least)
        from sup show "x \<sqsubseteq> s" ..
        from sup show "y \<sqsubseteq> s" ..
      qed
    qed
  qed

  theorem %invisible is_sup_related [elim?]: "x \<sqsubseteq> y \<Longrightarrow> is_sup x y y"
  proof -
    assume "x \<sqsubseteq> y"
    show ?thesis
    proof
      show "x \<sqsubseteq> y" by fact
      show "y \<sqsubseteq> y" ..
      fix z assume "x \<sqsubseteq> z" and "y \<sqsubseteq> z"
      show "y \<sqsubseteq> z" by fact
    qed
  qed

  end

text \<open>The syntax of the locale commands discussed in this tutorial is
  shown in Table~\ref{tab:commands}.  The grammar is complete with the
  exception of the context elements \isakeyword{constrains} and
  \isakeyword{defines}, which are provided for backward
  compatibility.  See the Isabelle/Isar Reference
  Manual \<^cite>\<open>IsarRef\<close> for full documentation.\<close>

section \<open>Import \label{sec:import}\<close>

text \<open>
  Algebraic structures are commonly defined by adding operations and
  properties to existing structures.  For example, partial orders
  are extended to lattices and total orders.  Lattices are extended to
  distributive lattices.\<close>

text \<open>
  With locales, this kind of inheritance is achieved through
  \emph{import} of locales.  The import part of a locale declaration,
  if present, precedes the context elements.  Here is an example,
  where partial orders are extended to lattices.
\<close>

  locale lattice = partial_order +
    assumes ex_inf: "\<exists>inf. is_inf x y inf"
      and ex_sup: "\<exists>sup. is_sup x y sup"
  begin

text \<open>These assumptions refer to the predicates for infimum
  and supremum defined for \<open>partial_order\<close> in the previous
  section.  We now introduce the notions of meet and join,
  together with an example theorem.\<close>

  definition
    meet (infixl "\<sqinter>" 70) where "x \<sqinter> y = (THE inf. is_inf x y inf)"
  definition
    join (infixl "\<squnion>" 65) where "x \<squnion> y = (THE sup. is_sup x y sup)"

  lemma %invisible meet_equality [elim?]: "is_inf x y i \<Longrightarrow> x \<sqinter> y = i"
  proof (unfold meet_def)
    assume "is_inf x y i"
    then show "(THE i. is_inf x y i) = i"
      by (rule the_equality) (rule is_inf_uniq [OF _ \<open>is_inf x y i\<close>])
  qed

  lemma %invisible meetI [intro?]:
      "i \<sqsubseteq> x \<Longrightarrow> i \<sqsubseteq> y \<Longrightarrow> (\<And>z. z \<sqsubseteq> x \<Longrightarrow> z \<sqsubseteq> y \<Longrightarrow> z \<sqsubseteq> i) \<Longrightarrow> x \<sqinter> y = i"
    by (rule meet_equality, rule is_infI) blast+

  lemma %invisible is_inf_meet [intro?]: "is_inf x y (x \<sqinter> y)"
  proof (unfold meet_def)
    from ex_inf obtain i where "is_inf x y i" ..
    then show "is_inf x y (THE i. is_inf x y i)"
      by (rule theI) (rule is_inf_uniq [OF _ \<open>is_inf x y i\<close>])
  qed

  lemma meet_left(*<*)[intro?](*>*): "x \<sqinter> y \<sqsubseteq> x"
    by (rule is_inf_lower) (rule is_inf_meet)

  lemma %invisible meet_right [intro?]:
    "x \<sqinter> y \<sqsubseteq> y"
    by (rule is_inf_lower) (rule is_inf_meet)

  lemma %invisible meet_le [intro?]:
    "\<lbrakk> z \<sqsubseteq> x; z \<sqsubseteq> y \<rbrakk> \<Longrightarrow> z \<sqsubseteq> x \<sqinter> y"
    by (rule is_inf_greatest) (rule is_inf_meet)

  lemma %invisible join_equality [elim?]: "is_sup x y s \<Longrightarrow> x \<squnion> y = s"
  proof (unfold join_def)
    assume "is_sup x y s"
    then show "(THE s. is_sup x y s) = s"
      by (rule the_equality) (rule is_sup_uniq [OF _ \<open>is_sup x y s\<close>])
  qed

  lemma %invisible joinI [intro?]: "x \<sqsubseteq> s \<Longrightarrow> y \<sqsubseteq> s \<Longrightarrow>
      (\<And>z. x \<sqsubseteq> z \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> s \<sqsubseteq> z) \<Longrightarrow> x \<squnion> y = s"
    by (rule join_equality, rule is_supI) blast+

  lemma %invisible is_sup_join [intro?]: "is_sup x y (x \<squnion> y)"
  proof (unfold join_def)
    from ex_sup obtain s where "is_sup x y s" ..
    then show "is_sup x y (THE s. is_sup x y s)"
      by (rule theI) (rule is_sup_uniq [OF _ \<open>is_sup x y s\<close>])
  qed

  lemma %invisible join_left [intro?]:
    "x \<sqsubseteq> x \<squnion> y"
    by (rule is_sup_upper) (rule is_sup_join)

  lemma %invisible join_right [intro?]:
    "y \<sqsubseteq> x \<squnion> y"
    by (rule is_sup_upper) (rule is_sup_join)

  lemma %invisible join_le [intro?]:
    "\<lbrakk> x \<sqsubseteq> z; y \<sqsubseteq> z \<rbrakk> \<Longrightarrow> x \<squnion> y \<sqsubseteq> z"
    by (rule is_sup_least) (rule is_sup_join)

  theorem %invisible meet_assoc: "(x \<sqinter> y) \<sqinter> z = x \<sqinter> (y \<sqinter> z)"
  proof (rule meetI)
    show "x \<sqinter> (y \<sqinter> z) \<sqsubseteq> x \<sqinter> y"
    proof
      show "x \<sqinter> (y \<sqinter> z) \<sqsubseteq> x" ..
      show "x \<sqinter> (y \<sqinter> z) \<sqsubseteq> y"
      proof -
        have "x \<sqinter> (y \<sqinter> z) \<sqsubseteq> y \<sqinter> z" ..
        also have "\<dots> \<sqsubseteq> y" ..
        finally show ?thesis .
      qed
    qed
    show "x \<sqinter> (y \<sqinter> z) \<sqsubseteq> z"
    proof -
      have "x \<sqinter> (y \<sqinter> z) \<sqsubseteq> y \<sqinter> z" ..
      also have "\<dots> \<sqsubseteq> z" ..
      finally show ?thesis .
    qed
    fix w assume "w \<sqsubseteq> x \<sqinter> y" and "w \<sqsubseteq> z"
    show "w \<sqsubseteq> x \<sqinter> (y \<sqinter> z)"
    proof
      show "w \<sqsubseteq> x"
      proof -
        have "w \<sqsubseteq> x \<sqinter> y" by fact
        also have "\<dots> \<sqsubseteq> x" ..
        finally show ?thesis .
      qed
      show "w \<sqsubseteq> y \<sqinter> z"
      proof
        show "w \<sqsubseteq> y"
        proof -
          have "w \<sqsubseteq> x \<sqinter> y" by fact
          also have "\<dots> \<sqsubseteq> y" ..
          finally show ?thesis .
        qed
        show "w \<sqsubseteq> z" by fact
      qed
    qed
  qed

  theorem %invisible meet_commute: "x \<sqinter> y = y \<sqinter> x"
  proof (rule meetI)
    show "y \<sqinter> x \<sqsubseteq> x" ..
    show "y \<sqinter> x \<sqsubseteq> y" ..
    fix z assume "z \<sqsubseteq> y" and "z \<sqsubseteq> x"
    then show "z \<sqsubseteq> y \<sqinter> x" ..
  qed

  theorem %invisible meet_join_absorb: "x \<sqinter> (x \<squnion> y) = x"
  proof (rule meetI)
    show "x \<sqsubseteq> x" ..
    show "x \<sqsubseteq> x \<squnion> y" ..
    fix z assume "z \<sqsubseteq> x" and "z \<sqsubseteq> x \<squnion> y"
    show "z \<sqsubseteq> x" by fact
  qed

  theorem %invisible join_assoc: "(x \<squnion> y) \<squnion> z = x \<squnion> (y \<squnion> z)"
  proof (rule joinI)
    show "x \<squnion> y \<sqsubseteq> x \<squnion> (y \<squnion> z)"
    proof
      show "x \<sqsubseteq> x \<squnion> (y \<squnion> z)" ..
      show "y \<sqsubseteq> x \<squnion> (y \<squnion> z)"
      proof -
        have "y \<sqsubseteq> y \<squnion> z" ..
        also have "... \<sqsubseteq> x \<squnion> (y \<squnion> z)" ..
        finally show ?thesis .
      qed
    qed
    show "z \<sqsubseteq> x \<squnion> (y \<squnion> z)"
    proof -
      have "z \<sqsubseteq> y \<squnion> z"  ..
      also have "... \<sqsubseteq> x \<squnion> (y \<squnion> z)" ..
      finally show ?thesis .
    qed
    fix w assume "x \<squnion> y \<sqsubseteq> w" and "z \<sqsubseteq> w"
    show "x \<squnion> (y \<squnion> z) \<sqsubseteq> w"
    proof
      show "x \<sqsubseteq> w"
      proof -
        have "x \<sqsubseteq> x \<squnion> y" ..
        also have "\<dots> \<sqsubseteq> w" by fact
        finally show ?thesis .
      qed
      show "y \<squnion> z \<sqsubseteq> w"
      proof
        show "y \<sqsubseteq> w"
        proof -
          have "y \<sqsubseteq> x \<squnion> y" ..
          also have "... \<sqsubseteq> w" by fact
          finally show ?thesis .
        qed
        show "z \<sqsubseteq> w" by fact
      qed
    qed
  qed

  theorem %invisible join_commute: "x \<squnion> y = y \<squnion> x"
  proof (rule joinI)
    show "x \<sqsubseteq> y \<squnion> x" ..
    show "y \<sqsubseteq> y \<squnion> x" ..
    fix z assume "y \<sqsubseteq> z" and "x \<sqsubseteq> z"
    then show "y \<squnion> x \<sqsubseteq> z" ..
  qed

  theorem %invisible join_meet_absorb: "x \<squnion> (x \<sqinter> y) = x"
  proof (rule joinI)
    show "x \<sqsubseteq> x" ..
    show "x \<sqinter> y \<sqsubseteq> x" ..
    fix z assume "x \<sqsubseteq> z" and "x \<sqinter> y \<sqsubseteq> z"
    show "x \<sqsubseteq> z" by fact
  qed

  theorem %invisible meet_idem: "x \<sqinter> x = x"
  proof -
    have "x \<sqinter> (x \<squnion> (x \<sqinter> x)) = x" by (rule meet_join_absorb)
    also have "x \<squnion> (x \<sqinter> x) = x" by (rule join_meet_absorb)
    finally show ?thesis .
  qed

  theorem %invisible meet_related [elim?]: "x \<sqsubseteq> y \<Longrightarrow> x \<sqinter> y = x"
  proof (rule meetI)
    assume "x \<sqsubseteq> y"
    show "x \<sqsubseteq> x" ..
    show "x \<sqsubseteq> y" by fact
    fix z assume "z \<sqsubseteq> x" and "z \<sqsubseteq> y"
    show "z \<sqsubseteq> x" by fact
  qed

  theorem %invisible meet_related2 [elim?]: "y \<sqsubseteq> x \<Longrightarrow> x \<sqinter> y = y"
    by (drule meet_related) (simp add: meet_commute)

  theorem %invisible join_related [elim?]: "x \<sqsubseteq> y \<Longrightarrow> x \<squnion> y = y"
  proof (rule joinI)
    assume "x \<sqsubseteq> y"
    show "y \<sqsubseteq> y" ..
    show "x \<sqsubseteq> y" by fact
    fix z assume "x \<sqsubseteq> z" and "y \<sqsubseteq> z"
    show "y \<sqsubseteq> z" by fact
  qed

  theorem %invisible join_related2 [elim?]: "y \<sqsubseteq> x \<Longrightarrow> x \<squnion> y = x"
    by (drule join_related) (simp add: join_commute)

  theorem %invisible meet_connection: "(x \<sqsubseteq> y) = (x \<sqinter> y = x)"
  proof
    assume "x \<sqsubseteq> y"
    then have "is_inf x y x" ..
    then show "x \<sqinter> y = x" ..
  next
    have "x \<sqinter> y \<sqsubseteq> y" ..
    also assume "x \<sqinter> y = x"
    finally show "x \<sqsubseteq> y" .
  qed

  theorem %invisible join_connection: "(x \<sqsubseteq> y) = (x \<squnion> y = y)"
  proof
    assume "x \<sqsubseteq> y"
    then have "is_sup x y y" ..
    then show "x \<squnion> y = y" ..
  next
    have "x \<sqsubseteq> x \<squnion> y" ..
    also assume "x \<squnion> y = y"
    finally show "x \<sqsubseteq> y" .
  qed

  theorem %invisible meet_connection2: "(x \<sqsubseteq> y) = (y \<sqinter> x = x)"
    using meet_commute meet_connection by simp

  theorem %invisible join_connection2: "(x \<sqsubseteq> y) = (x \<squnion> y = y)"
    using join_commute join_connection by simp

  text %invisible \<open>Naming according to Jacobson I, p.\ 459.\<close>
  lemmas %invisible L1 = join_commute meet_commute
  lemmas %invisible L2 = join_assoc meet_assoc
  (* lemmas L3 = join_idem meet_idem *)
  lemmas %invisible L4 = join_meet_absorb meet_join_absorb

  end

text \<open>Locales for total orders and distributive lattices follow to
  establish a sufficiently rich landscape of locales for
  further examples in this tutorial.\<close>

  locale total_order = partial_order +
    assumes total: "x \<sqsubseteq> y \<or> y \<sqsubseteq> x"

  lemma (in total_order) less_total: "x \<sqsubset> y \<or> x = y \<or> y \<sqsubset> x"
    using total
    by (unfold less_def) blast

  locale distrib_lattice = lattice +
    assumes meet_distr: "x \<sqinter> (y \<squnion> z) = x \<sqinter> y \<squnion> x \<sqinter> z"

  lemma (in distrib_lattice) join_distr:
    "x \<squnion> (y \<sqinter> z) = (x \<squnion> y) \<sqinter> (x \<squnion> z)"  (* txt {* Jacobson I, p.\ 462 *} *)
    proof -
    have "x \<squnion> (y \<sqinter> z) = (x \<squnion> (x \<sqinter> z)) \<squnion> (y \<sqinter> z)" by (simp add: L4)
    also have "... = x \<squnion> ((x \<sqinter> z) \<squnion> (y \<sqinter> z))" by (simp add: L2)
    also have "... = x \<squnion> ((x \<squnion> y) \<sqinter> z)" by (simp add: L1 meet_distr)
    also have "... = ((x \<squnion> y) \<sqinter> x) \<squnion> ((x \<squnion> y) \<sqinter> z)" by (simp add: L1 L4)
    also have "... = (x \<squnion> y) \<sqinter> (x \<squnion> z)" by (simp add: meet_distr)
    finally show ?thesis .
  qed

text \<open>
  The locale hierarchy obtained through these declarations is shown in
  Figure~\ref{fig:lattices}(a).

\begin{figure}
\hrule \vspace{2ex}
\begin{center}
\subfigure[Declared hierarchy]{
\begin{tikzpicture}
  \node (po) at (0,0) {\<open>partial_order\<close>};
  \node (lat) at (-1.5,-1) {\<open>lattice\<close>};
  \node (dlat) at (-1.5,-2) {\<open>distrib_lattice\<close>};
  \node (to) at (1.5,-1) {\<open>total_order\<close>};
  \draw (po) -- (lat);
  \draw (lat) -- (dlat);
  \draw (po) -- (to);
%  \draw[->, dashed] (lat) -- (to);
\end{tikzpicture}
} \\
\subfigure[Total orders are lattices]{
\begin{tikzpicture}
  \node (po) at (0,0) {\<open>partial_order\<close>};
  \node (lat) at (0,-1) {\<open>lattice\<close>};
  \node (dlat) at (-1.5,-2) {\<open>distrib_lattice\<close>};
  \node (to) at (1.5,-2) {\<open>total_order\<close>};
  \draw (po) -- (lat);
  \draw (lat) -- (dlat);
  \draw (lat) -- (to);
%  \draw[->, dashed] (dlat) -- (to);
\end{tikzpicture}
} \quad
\subfigure[Total orders are distributive lattices]{
\begin{tikzpicture}
  \node (po) at (0,0) {\<open>partial_order\<close>};
  \node (lat) at (0,-1) {\<open>lattice\<close>};
  \node (dlat) at (0,-2) {\<open>distrib_lattice\<close>};
  \node (to) at (0,-3) {\<open>total_order\<close>};
  \draw (po) -- (lat);
  \draw (lat) -- (dlat);
  \draw (dlat) -- (to);
\end{tikzpicture}
}
\end{center}
\hrule
\caption{Hierarchy of Lattice Locales.}
\label{fig:lattices}
\end{figure}
\<close>

section \<open>Changing the Locale Hierarchy
  \label{sec:changing-the-hierarchy}\<close>

text \<open>
  Locales enable to prove theorems abstractly, relative to
  sets of assumptions.  These theorems can then be used in other
  contexts where the assumptions themselves, or
  instances of the assumptions, are theorems.  This form of theorem
  reuse is called \emph{interpretation}.  Locales generalise
  interpretation from theorems to conclusions, enabling the reuse of
  definitions and other constructs that are not part of the
  specifications of the locales.

  The first form of interpretation we will consider in this tutorial
  is provided by the \isakeyword{sublocale} command.  It enables to
  modify the import hierarchy to reflect the \emph{logical} relation
  between locales.

  Consider the locale hierarchy from Figure~\ref{fig:lattices}(a).
  Total orders are lattices, although this is not reflected here, and
  definitions, theorems and other conclusions
  from \<^term>\<open>lattice\<close> are not available in \<^term>\<open>total_order\<close>.  To
  obtain the situation in Figure~\ref{fig:lattices}(b), it is
  sufficient to add the conclusions of the latter locale to the former.
  The \isakeyword{sublocale} command does exactly this.
  The declaration \isakeyword{sublocale} $l_1
  \subseteq l_2$ causes locale $l_2$ to be \emph{interpreted} in the
  context of $l_1$.  This means that all conclusions of $l_2$ are made
  available in $l_1$.

  Of course, the change of hierarchy must be supported by a theorem
  that reflects, in our example, that total orders are indeed
  lattices.  Therefore the \isakeyword{sublocale} command generates a
  goal, which must be discharged by the user.  This is illustrated in
  the following paragraphs.  First the sublocale relation is stated.
\<close>

  sublocale %visible total_order \<subseteq> lattice

txt \<open>\normalsize
  This enters the context of locale \<open>total_order\<close>, in
  which the goal @{subgoals [display]} must be shown.
  Now the
  locale predicate needs to be unfolded --- for example, using its
  definition or by introduction rules
  provided by the locale package.  For automation, the locale package
  provides the methods \<open>intro_locales\<close> and \<open>unfold_locales\<close>.  They are aware of the
  current context and dependencies between locales and automatically
  discharge goals implied by these.  While \<open>unfold_locales\<close>
  always unfolds locale predicates to assumptions, \<open>intro_locales\<close> only unfolds definitions along the locale
  hierarchy, leaving a goal consisting of predicates defined by the
  locale package.  Occasionally the latter is of advantage since the goal
  is smaller.

  For the current goal, we would like to get hold of
  the assumptions of \<open>lattice\<close>, which need to be shown, hence
  \<open>unfold_locales\<close> is appropriate.\<close>

  proof unfold_locales

txt \<open>\normalsize
  Since the fact that both lattices and total orders are partial
  orders is already reflected in the locale hierarchy, the assumptions
  of \<open>partial_order\<close> are discharged automatically, and only the
  assumptions introduced in \<open>lattice\<close> remain as subgoals
  @{subgoals [display]}
  The proof for the first subgoal is obtained by constructing an
  infimum, whose existence is implied by totality.\<close>

    fix x y
    from total have "is_inf x y (if x \<sqsubseteq> y then x else y)"
      by (auto simp: is_inf_def)
    then show "\<exists>inf. is_inf x y inf" ..
txt \<open>\normalsize
   The proof for the second subgoal is analogous and not
  reproduced here.\<close>
  next %invisible
    fix x y
    from total have "is_sup x y (if x \<sqsubseteq> y then y else x)"
      by (auto simp: is_sup_def)
    then show "\<exists>sup. is_sup x y sup" .. qed %visible

text \<open>Similarly, we may establish that total orders are distributive
  lattices with a second \isakeyword{sublocale} statement.\<close>

  sublocale total_order \<subseteq> distrib_lattice
    proof unfold_locales
    fix %"proof" x y z
    show "x \<sqinter> (y \<squnion> z) = x \<sqinter> y \<squnion> x \<sqinter> z" (is "?l = ?r")
      txt \<open>Jacobson I, p.\ 462\<close>
    proof -
      { assume c: "y \<sqsubseteq> x" "z \<sqsubseteq> x"
        from c have "?l = y \<squnion> z"
          by (metis c join_connection2 join_related2 meet_related2 total)
        also from c have "... = ?r" by (metis meet_related2)
        finally have "?l = ?r" . }
      moreover
      { assume c: "x \<sqsubseteq> y \<or> x \<sqsubseteq> z"
        from c have "?l = x"
          by (metis join_connection2 join_related2 meet_connection total trans)
        also from c have "... = ?r"
          by (metis join_commute join_related2 meet_connection meet_related2 total)
        finally have "?l = ?r" . }
      moreover note total
      ultimately show ?thesis by blast
    qed
  qed

text \<open>The locale hierarchy is now as shown in
  Figure~\ref{fig:lattices}(c).\<close>

text \<open>
  Locale interpretation is \emph{dynamic}.  The statement
  \isakeyword{sublocale} $l_1 \subseteq l_2$ will not just add the
  current conclusions of $l_2$ to $l_1$.  Rather the dependency is
  stored, and conclusions that will be
  added to $l_2$ in future are automatically propagated to $l_1$.
  The sublocale relation is transitive --- that is, propagation takes
  effect along chains of sublocales.  Even cycles in the sublocale relation are
  supported, as long as these cycles do not lead to infinite chains.
  Details are discussed in the technical report \<^cite>\<open>Ballarin2006a\<close>.
  See also Section~\ref{sec:infinite-chains} of this tutorial.\<close>

end


theory SINVAR_SubnetsInGW
imports"../TopoS_Helper"
begin

subsection \<open>SecurityInvariant SubnetsInGW\<close>

datatype subnets = Member | InboundGateway | Unassigned

definition default_node_properties :: "subnets"
  where  "default_node_properties \<equiv> Unassigned"

fun allowed_subnet_flow :: "subnets \<Rightarrow> subnets \<Rightarrow> bool" where
  "allowed_subnet_flow Member _ = True" |
  "allowed_subnet_flow InboundGateway _ = True" |
  "allowed_subnet_flow Unassigned Unassigned = True" |
  "allowed_subnet_flow Unassigned InboundGateway = True"|
  "allowed_subnet_flow Unassigned Member = False"

fun sinvar :: "'v graph \<Rightarrow> ('v \<Rightarrow> subnets)  \<Rightarrow> bool" where
  "sinvar G nP = (\<forall> (e1,e2) \<in> edges G. allowed_subnet_flow (nP e1) (nP e2))"

definition receiver_violation :: "bool" where "receiver_violation = False"

subsubsection \<open>Preliminaries\<close>

subsubsection\<open>ENF\<close>
  lemma Unassigned_not_to_Member: "\<not> allowed_subnet_flow Unassigned Member"
    by(simp)
  lemma All_to_Unassigned: "allowed_subnet_flow e1 Unassigned"
    by (case_tac e1, simp_all)
  lemma Member_to_All: "allowed_subnet_flow Member e2"
    by (case_tac e2, simp_all)
  lemma Unassigned_default_candidate: "\<forall> nP e1 e2. \<not> allowed_subnet_flow (nP e1) (nP e2) \<longrightarrow> \<not> allowed_subnet_flow Unassigned (nP e2)"
    apply(rule allI)+
    apply(case_tac "nP e2")
      apply simp
     apply(case_tac "nP e1")
       apply(simp_all)[3]
    by(simp add: All_to_Unassigned)
  lemma allowed_subnet_flow_refl: "allowed_subnet_flow e e"
    by(case_tac e, simp_all)
  lemma SubnetsInGW_ENF: "SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form sinvar allowed_subnet_flow"
    unfolding SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form_def
    by simp
  lemma SubnetsInGW_ENF_refl: "SecurityInvariant_withOffendingFlows.ENF_refl sinvar allowed_subnet_flow"
    unfolding SecurityInvariant_withOffendingFlows.ENF_refl_def
    apply(rule conjI)
     apply(simp add: SubnetsInGW_ENF)
    apply(simp add: allowed_subnet_flow_refl)
  done

  definition SubnetsInGW_offending_set:: "'v graph \<Rightarrow> ('v \<Rightarrow> subnets) \<Rightarrow> ('v \<times> 'v) set set" where
  "SubnetsInGW_offending_set G nP = (if sinvar G nP then
      {}
     else
      { {e \<in> edges G. case e of (e1,e2) \<Rightarrow> \<not> allowed_subnet_flow (nP e1) (nP e2)} })"
  lemma SubnetsInGW_offending_set:
  "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = SubnetsInGW_offending_set"
    apply(simp only: fun_eq_iff ENF_offending_set[OF SubnetsInGW_ENF] SubnetsInGW_offending_set_def)
    apply(rule allI)+
    apply(rename_tac G nP)
    apply(auto)
  done

interpretation SubnetsInGW: SecurityInvariant_ACS
where default_node_properties = SINVAR_SubnetsInGW.default_node_properties
and sinvar = SINVAR_SubnetsInGW.sinvar
rewrites "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = SubnetsInGW_offending_set"
  unfolding SINVAR_SubnetsInGW.default_node_properties_def
  apply unfold_locales

    apply(rule ballI)
    thm SecurityInvariant_withOffendingFlows.ENF_fsts_refl_instance[OF SubnetsInGW_ENF_refl Unassigned_default_candidate]
    apply(rule SecurityInvariant_withOffendingFlows.ENF_fsts_refl_instance[OF SubnetsInGW_ENF_refl Unassigned_default_candidate])
      apply(simp_all)[2]

   apply(erule default_uniqueness_by_counterexample_ACS)
   apply (simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_def)
   apply (simp add:graph_ops)
   apply (simp split: prod.split_asm prod.split)
   apply(rule_tac x="\<lparr> nodes={vertex_1,vertex_2}, edges = {(vertex_1,vertex_2)} \<rparr>" in exI, simp)
   apply(rule conjI)
    apply(simp add: wf_graph_def)
   apply(case_tac otherbot, simp_all)
   apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := Member)" in exI, simp)
    apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
   apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := Member)" in exI, simp)
   apply(rule_tac x="vertex_1" in exI, simp)
   apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)

  apply(fact SubnetsInGW_offending_set)
  done

  lemma TopoS_SubnetsInGW: "SecurityInvariant sinvar default_node_properties receiver_violation"
  unfolding receiver_violation_def by unfold_locales

hide_fact (open) sinvar_mono
hide_const (open) sinvar receiver_violation default_node_properties

end


theory deMorgan1
  imports Main

begin

text\<open> Apply style \<close>
theorem de_morgan_1 : "(\<not> (p \<or> q)) \<longrightarrow> (\<not> p \<and> \<not> q)"
  apply (rule impI)
  apply (rule conjI)
  apply (rule notI)
  apply (erule notE)
  apply (rule disjI1)
  apply assumption
  apply (rule notI)
  apply (erule notE)
  apply (rule disjI2)
  apply assumption
  done
end


subsection "Denotational equalities regarding reduction"

theory DenotEqualitiesFSet
  imports DenotCongruenceFSet
begin

theorem eval_prim[simp]: assumes e1:"E e1 = E (ENat n1)" and e2:"E e2 = E (ENat n2)"
  shows "E(EPrim f e1 e2)=E(ENat (f n1 n2))"
    using e1 e2 by auto

theorem eval_app_lam: assumes vv: "is_val v"
  shows "E(EApp (ELam x e) v) = E (subst x v e)"
  apply (rule ext) apply (rule equalityI) apply (rule subsetI)
   apply (subgoal_tac "EApp (ELam x e) v \<longrightarrow> subst x v e") prefer 2 apply (rule beta)
  using vv apply assumption apply (rule subject_reduction) apply assumption apply assumption
  apply (rule subsetI)
  apply (subgoal_tac "EApp (ELam x e) v \<longrightarrow> subst x v e") prefer 2 apply (rule beta)
  using vv apply assumption apply (rule reverse_step_pres_denot) apply assumption
  apply assumption
  done

end


(*
    Author:      René Thiemann
                 Akihisa Yamada
    License:     BSD
*)
section \<open>Application: Complexity of Matrix Orderings\<close>

text \<open>In this theory we provide various carriers which can be used for matrix interpretations.\<close>

theory Matrix_Complexity
imports
  Matrix_Comparison
  Complexity_Carrier
  Show_Arctic
begin

subsection \<open>Locales for Carriers of Matrix Interpretations and Polynomial Orders\<close>

locale matrix_carrier = SN_one_mono_ordered_semiring_1 d gt
  for gt :: "'a :: {show,ordered_semiring_1} \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<succ>" 50) and d :: "'a"

locale mono_matrix_carrier = complexity_one_mono_ordered_semiring_1 gt d bound
  for gt :: "'a :: {show,large_real_ordered_semiring_1} \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<succ>" 50) and d :: 'a
  and bound :: "'a \<Rightarrow> nat"
+ fixes mono :: "'a \<Rightarrow> bool"
  assumes mono: "\<And> x y z. mono x \<Longrightarrow> y \<succ> z \<Longrightarrow> x \<ge> 0 \<Longrightarrow> x * y \<succ> x * z"

text \<open>The weak version make comparison with $>$ and then synthesize a suitable
  $\delta$-ordering by choosing the least difference in the finite set of
  comparisons.\<close>

locale weak_complexity_linear_poly_order_carrier =
  fixes weak_gt :: "'a :: {large_real_ordered_semiring_1,show} \<Rightarrow> 'a \<Rightarrow> bool"
   and  default :: "'a"
   and  mono :: "'a \<Rightarrow> bool"
  assumes weak_gt_mono: "\<forall> x y. (x,y) \<in> set xys \<longrightarrow> weak_gt x y
  \<Longrightarrow> \<exists> gt bound. mono_matrix_carrier gt default bound mono \<and> (\<forall> x y. (x,y) \<in> set xys \<longrightarrow> gt x y)"
begin

abbreviation weak_mat_gt :: "nat \<Rightarrow> 'a mat \<Rightarrow> 'a mat \<Rightarrow> bool"
where "weak_mat_gt \<equiv> mat_gt weak_gt"

lemma weak_mat_gt_mono: assumes sd_n: "sd \<le> n" and
    orient: "\<And> A B. A \<in> carrier_mat n n \<Longrightarrow> B \<in> carrier_mat n n \<Longrightarrow> (A,B) \<in> set ABs \<Longrightarrow> weak_mat_gt sd A B"
   shows "\<exists> gt bound. mono_matrix_carrier gt default bound mono
   \<and> (\<forall> A B. A \<in> carrier_mat n n \<longrightarrow> B \<in> carrier_mat n n \<longrightarrow> (A, B) \<in> set ABs \<longrightarrow> mat_gt gt sd A B)"
proof -
  let ?n = "[0 ..< n]"
  let ?m1x = "[ A $$ (i,j) . A <- map fst ABs, i <- ?n, j <- ?n]"
  let ?m2y = "[ B $$ (i,j) . B <- map snd ABs, i <- ?n, j <- ?n]"
  let ?pairs = "concat (map (\<lambda> x. map (\<lambda> y. (x,y)) ?m2y) ?m1x)"
  let ?strict = "filter (\<lambda> (x,y). weak_gt x y) ?pairs"
  have "\<forall> x y. (x,y) \<in> set ?strict \<longrightarrow> weak_gt x y" by auto
  from weak_gt_mono[OF this] obtain gt bound where order: "mono_matrix_carrier gt default bound mono"
    and orient2: "\<And> x y. (x, y) \<in> set ?strict \<Longrightarrow> gt x y" by auto
  show ?thesis
  proof (intro exI allI conjI impI, rule order)
    fix A B
    assume A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
      and AB: "(A, B) \<in> set ABs"
    from orient[OF this] have "mat_gt weak_gt sd A B" by auto
    from mat_gtD[OF this] obtain i j where
      ge: "A \<ge>\<^sub>m B" and ij: "i < sd" "j < sd" and wgt: "weak_gt (A $$ (i,j)) (B $$ (i,j))"
      by auto
    from ij \<open>sd \<le> n\<close> have ij': "i < n" "j < n" by auto
    have gt: "gt (A $$ (i,j)) (B $$ (i,j))"
      by (rule orient2, insert ij' AB wgt, force)
    show "mat_gt gt sd A B" using ij gt ge by auto
  qed
qed
end

sublocale mono_matrix_carrier \<subseteq> SN_strict_mono_ordered_semiring_1 d gt mono
proof
  show "SN {(x,y). y \<ge> 0 \<and> x \<succ> y}"
    unfolding SN_def
    by (intro allI deriv_bound_SN_on[OF bound])
qed (rule mono)

sublocale mono_matrix_carrier \<subseteq> matrix_carrier ..

subsection \<open>The Integers as Carrier\<close>

lemma int_complexity:
  "mono_matrix_carrier ((>) :: int \<Rightarrow> int \<Rightarrow> bool) 1 nat int_mono"
proof (unfold_locales)
  fix x
  let ?R = "{(x, y). 0 \<le> (y :: int) \<and> y < x}"
  show "deriv_bound ?R x (nat x)"
    unfolding deriv_bound_def
  proof
    assume "(\<exists> y. (x,y) \<in> ?R ^^ Suc (nat x))"
    then obtain y where xy: "(x,y) \<in> ?R ^^ Suc (nat x)" ..
    from xy have y: "0 \<le> y" by auto
    obtain n where n: "n = Suc (nat x)" by auto
    from xy[unfolded n[symmetric]]
    have "x \<ge> y + int n"
    proof (induct n arbitrary: x y)
      case 0 thus ?case by auto
    next
      case (Suc n)
      from Suc(2) obtain z where xz: "(x,z) \<in> ?R ^^ n" and zy: "(z,y) \<in> ?R"
        by auto
      from Suc(1)[OF xz] have le: "z + int n \<le> x" .
      from zy have le2: "y + 1 \<le> z" by simp
      with le show ?case by auto
    qed
    with y have nx: "int n \<le> x" by simp
    from nx have x0: "x \<ge> 0" by simp
    with nx n
    show False by simp
  qed
qed (insert int_SN.mono, auto)

lemma int_weak_complexity:
  "weak_complexity_linear_poly_order_carrier (>) 1 int_mono"
  by (unfold_locales, intro exI[of _ "(>)"] exI[of _ nat] conjI, rule int_complexity, auto)

subsection \<open>The Rational and Real Numbers as Carrier\<close>

definition delta_bound :: "'a :: floor_ceiling \<Rightarrow> 'a \<Rightarrow> nat"
where
  "delta_bound d x = nat (ceiling (x * of_int (ceiling (1 / d))))"

lemma delta_complexity:
  assumes d0: "d > 0" and d1: "d \<le> def"
  shows "mono_matrix_carrier (delta_gt d) def (delta_bound d) delta_mono"
proof -
  from d0 have d00: "0 \<le> d" by simp
  define N where "N = ceiling (1 / d)"
  let ?N = "of_int N :: 'a"
  from d0 have "1 / d > 0" by (auto simp: field_simps)
  with ceiling_correct[of "1 / d"] have Nd: "1 / d \<le> ?N" and N: "N > 0" unfolding N_def by auto
  let ?nat = "\<lambda> x. nat (ceiling (x * ?N))"
  let ?gt = "delta_gt d"
  have nn: "delta_bound d = ?nat" unfolding fun_eq_iff N_def by (simp add: delta_bound_def)
  from delta_interpretation[OF d0 d1]
  interpret SN_strict_mono_ordered_semiring_1 "def" ?gt delta_mono .
  show ?thesis unfolding nn
  proof(unfold_locales)
    show "?nat 0 = 0" by auto
  next
    fix x y :: 'a
    assume xy: "x \<ge> y"
    show "?nat x \<ge> ?nat y"
      by (rule nat_mono, rule ceiling_mono, insert xy N, auto simp: field_simps)
  next
    have "1 \<le> nat 1" by simp
    also have "... \<le> ?nat 1"
    proof (rule nat_mono)
      have "1 = ceiling (1 :: rat)" by simp
      also have "... \<le> ceiling (1 * ?N)" using N by simp
      finally show "1 \<le> ceiling (1 * ?N)" .
    qed
    finally show "1 \<le> ?nat 1" .
  next
    fix x y :: 'a
    have "ceiling ((x + y) * ?N) = ceiling (x * ?N + y * ?N)" by (simp add: field_simps)
    also have "... \<le> ceiling (x * ?N) + ceiling (y * ?N)" by (rule ceiling_add_le)
    finally show "?nat (x + y) \<le> ?nat x + ?nat y" by auto
  next
    fix x :: 'a and n :: nat
    assume x: "0 \<le> x"
    interpret mono_matrix_carrier "(>)" 1 nat int_mono by (rule int_complexity)
    have "?nat (x + of_nat n) = nat (ceiling (x * ?N + of_nat n * ?N))"
      by (simp add: field_simps)
    also have id: "of_nat n * ?N = of_int (of_nat (n * nat N))" using N by (simp add: field_simps)
    also have "ceiling (x * ?N + of_int (of_nat (n * nat N))) = ceiling (x * ?N) + of_nat (n * nat N)" unfolding ceiling_add_of_int ..
    also have "nat (ceiling (x * ?N) + of_nat (n * nat N)) = ?nat x + nat (int (n * nat N))"
    proof (rule bound_plus_of_nat)
      have "x * ?N \<ge> 0"
        by (rule mult_nonneg_nonneg, insert x N, auto)
      thus "ceiling (x * ?N) \<ge> 0" by auto
    qed
    also have "(nat (int (n * nat N))) = n * nat N" by presburger
    also have "n * nat N = ?nat (of_nat n)" using N by (metis id ceiling_of_int nat_int)
    finally
    show "?nat (x + of_nat n) = ?nat x + ?nat (of_nat n)" .
  next
    fix x y z :: 'a
    assume *: "delta_mono x" "delta_gt d y z" and x: "0 \<le> x"
    from mono[OF * x]
    show "delta_gt d (x * y) (x * z)" .
  next
    fix x :: 'a
    let ?R = "{(x,y). 0 \<le> y \<and> ?gt x y}"
    show "deriv_bound ?R x (?nat x)" unfolding deriv_bound_def
    proof
      assume "(\<exists> y. (x,y) \<in> ?R ^^ Suc (?nat x))"
      then obtain y where xy: "(x,y) \<in> ?R ^^ Suc (?nat x)" ..
      from xy have y: "0 \<le> y" by auto
      obtain n where n: "n = Suc (?nat x)" by auto
      from xy[unfolded n[symmetric]]
      have "x \<ge> y + d * of_nat n"
      proof (induct n arbitrary: x y)
        case 0 thus ?case by auto
      next
        case (Suc n)
        from Suc(2) obtain z where xz: "(x,z) \<in> ?R ^^ n" and zy: "(z,y) \<in> ?R"
          by auto
        from Suc(1)[OF xz] have le: "z + d * of_nat n \<le> x" .
        from zy[unfolded delta_gt_def] have le2: "y + d \<le> z" by simp
        with le show ?case by (auto simp: field_simps)
      qed
      with y have nx: "d * of_nat n \<le> x" by simp
      have "0 \<le> d * of_nat n" by (rule mult_nonneg_nonneg, insert d00, auto)
      with nx have x0: "x \<ge> 0" by auto
      have xd0: "0 \<le> x / d"
        by (rule divide_nonneg_pos[OF x0 d0])
      from nx[unfolded n]
      have "d + d * of_nat (?nat x) \<le> x" by (simp add: field_simps)
      with d0 have less: "d * of_nat (?nat x) < x" by simp
      from Nd d0 have "1 \<le> d * ?N" by (auto simp: field_simps)
      from mult_left_mono[OF this x0]
      have "x \<le> d * (x * ?N)" by (simp add: ac_simps)
      also have "\<dots> \<le> d * of_nat (?nat x)"
      proof (rule mult_left_mono[OF _ d00])
        show "x * ?N \<le> of_nat (nat \<lceil>x * ?N\<rceil>)" using x0 ceiling_correct[of "x * ?N"]
          by (metis int_nat_eq le_cases of_int_0_le_iff of_int_of_nat_eq order_trans)
      qed
      also have "\<dots> < x" using less .
      finally show False by simp
    qed
  qed
qed

lemma delta_weak_complexity_carrier:
  assumes d0: "def > 0"
  shows "weak_complexity_linear_poly_order_carrier (>) def delta_mono"
proof
  fix xys :: "('a \<times> 'a) list"
  assume ass: "\<forall>x y. (x, y) \<in> set xys \<longrightarrow> y < x"
  let ?cs = "map (\<lambda> (x,y). x - y) xys"
  let ?ds = "def # ?cs"
  define d where "d = Min (set ?ds)"
  have d: "d \<le> def" and dcs: "\<And> x. x \<in> set ?cs \<Longrightarrow> d \<le> x" unfolding d_def by auto
  have "d \<in> set ?ds" unfolding d_def by (rule Min_in, auto)
  hence "d = def \<or> d \<in> set ?cs" by auto
  hence d0: "d > 0"
    by (cases, insert d0 ass, auto simp: field_simps)
  show "\<exists>gt bound. mono_matrix_carrier gt def bound delta_mono \<and> (\<forall>x y. (x, y) \<in> set xys \<longrightarrow> gt x y)"
    by (intro exI conjI, rule delta_complexity[OF d0 d], insert dcs, force simp: delta_gt_def)
qed

subsection \<open>The Arctic Numbers as Carrier\<close>

lemma arctic_delta_weak_carrier:
  "weak_SN_both_mono_ordered_semiring_1 weak_gt_arctic_delta 1 pos_arctic_delta" ..

lemma arctic_weak_carrier:
  "weak_SN_both_mono_ordered_semiring_1 (>) 1 pos_arctic"
proof -
  have SN: "SN_both_mono_ordered_semiring_1 1 (>) pos_arctic" ..
  show ?thesis
    by (unfold_locales, intro conjI exI, rule SN, auto)
qed

end


theory Oalist_Lemmas
  imports Oalist
begin

lemma empty_get :
  "get empty k = None"
  by(transfer; auto)

lemma str_ord_update_str_ord_update :
  assumes H: "strict_order (map fst l)"
  shows "str_ord_update k v' (str_ord_update k v l) = str_ord_update k v' l"
proof(induction l)
  case Nil
  then show ?case by auto
next
  case (Cons lh lt)

  obtain lk lv where Lh : "lh = (lk, lv)"
    by(cases lh; auto)

  show ?case using Cons Lh
    by(auto)
qed

lemma update_update :
  "update k v' (update k v l) = update k v' l"
  by(transfer; auto simp add: str_ord_update_str_ord_update)

lemma alist_all_val_get :
  assumes H : "alist_all_val P l"
  assumes K : "map_of l k = Some r"
  shows "P r" using assms
proof(induction l arbitrary: k)
  case Nil
  then show ?case
    by(auto)
next
  case (Cons lh lt)

  obtain lhk lhv where Lh :  "lh = (lhk, lhv)"
    by(cases lh; auto)

  show ?case
  proof(cases "lhk = k")
    case True
    then show ?thesis using Cons Lh
      by(auto simp add: alist_all_val_def)
  next
    case False

    have Ind : "alist_all_val P lt" using Cons
      by(auto simp add: alist_all_val_def)

    show ?thesis using Cons.prems Cons.IH[OF Ind] Lh False
      by(auto)
  qed
qed

lemma oalist_all_val_get :
  assumes H : "oalist_all_val P l"
  assumes K : "get l k = Some r"
  shows "P r"
  using assms
proof(transfer)
  fix P l k r
  show "strict_order (map fst l) \<Longrightarrow> alist_all_val P l \<Longrightarrow> map_of l k = Some r \<Longrightarrow> P r"
    using assms alist_all_val_get[of P l k r]
    by auto
qed

lemma alist_all_val_get_conv :
  assumes H0 : "strict_order (map fst l)"
  assumes H : "\<And> k r . map_of l k = Some r \<Longrightarrow> P r"
  shows "alist_all_val P l"
  using assms
proof(induction l)
  case Nil
  then show ?case by (auto simp add: alist_all_val_def)
next
  case (Cons lh lt)

  obtain lhk lhv where Lh :  "lh = (lhk, lhv)"
    by(cases lh; auto)

  show ?case
  proof(cases "P lhv")
    case True

    have Ord_tl : "strict_order (map fst lt)"
      using strict_order_tl[of lhk "map fst lt"] Cons.prems Lh
      by auto

    have Hyp : "(\<And>k r. map_of lt k = Some r \<Longrightarrow> P r)"
    proof-
      fix k r
      assume M : "map_of lt k = Some r"

      then have Neq : "k \<noteq> lhk"
      proof(cases "k = lhk")
        case True' : True

        then have In : "k \<in> set (map fst lt)" using imageI[OF map_of_SomeD[OF M], of fst]
          by auto

        then have  False
          using strict_order_distinct[OF Cons.prems(1)] Lh True'
          by(auto)

        thus ?thesis by auto
      next
        case False' : False
        then show ?thesis by auto
      qed

      then have Conc' : "map_of (lh # lt) k = Some r"
        using Lh M
        by(auto)

      show "P r" using Cons.prems(2)[OF Conc']
        by(auto)
    qed

    show ?thesis using Cons.IH[OF Ord_tl Hyp] True Lh
      by(auto simp add: alist_all_val_def)
  next
    case False

    have "P lhv"
      using Lh Cons.prems(2)[of lhk lhv]
      by auto

    hence False using False by auto

    thus ?thesis by auto
  qed
qed

lemma oalist_all_val_get_eq :
  "oalist_all_val P l = (\<forall> k r . get l k = Some r \<longrightarrow> P r)"
proof(transfer)
  fix P l
  assume Ord : "strict_order (map fst l)"
  show "alist_all_val P l = (\<forall>k r. map_of l k = Some r \<longrightarrow> P r)"
  proof
    assume "alist_all_val P l"
    then show "\<forall>k r. map_of l k = Some r \<longrightarrow> P r"
      using alist_all_val_get
      by auto
  next
    assume " \<forall>k r. map_of l k = Some r \<longrightarrow> P r"
    then show "alist_all_val P l"
      using alist_all_val_get_conv[OF Ord]
      by auto
  qed
qed

lemma str_ord_zip_get :
  assumes "strict_order (map fst l1)"
  assumes "strict_order (map fst l2)"
  shows "map_of (str_ord_zip flr fl fr l1 l2) k =
    (case (map_of l1 k, map_of l2 k) of (None, None) \<Rightarrow> None | (None, Some vr) \<Rightarrow> Some (fr k vr) | (Some vl, None) \<Rightarrow> Some (fl k vl) | (Some vl, Some vr) \<Rightarrow> Some (flr k vl vr))"
  using assms str_ord_zip_get' by blast

lemma oalist_zip_get :
  shows "get (oalist_zip flr fl fr l1 l2) k =
    (case (get l1 k, get l2 k) of (None, None) \<Rightarrow> None | (None, Some vr) \<Rightarrow> Some (fr k vr) | (Some vl, None) \<Rightarrow> Some (fl k vl) | (Some vl, Some vr) \<Rightarrow> Some (flr k vl vr))"
proof(transfer)
  fix flr fl fr l1 l2 k
  show "strict_order (map fst l1) \<Longrightarrow>
       strict_order (map fst l2) \<Longrightarrow>
       map_of (str_ord_zip flr fl fr l1 l2) k =
       (case (map_of l1 k, map_of l2 k) of
        (None, None) \<Rightarrow> None
        | (None, Some vr) \<Rightarrow> Some (fr k vr)
        | (Some vl, None) \<Rightarrow> Some (fl k vl)
        | (Some vl, Some vr) \<Rightarrow>
            Some (flr k vl vr))"
    using str_ord_zip_get
    by blast
qed

lemma strict_order_cons' :
  assumes H1 : "strict_order (hk#t)"
  assumes H2 : "k' \<in> set t"
  shows "hk < k'"
proof-
  obtain k'_idx where "t ! k'_idx = k'" "k'_idx < length t"
    using H2
    unfolding in_set_conv_nth
    by(blast)

  then show ?thesis
    using strict_order_unfold[OF H1, of "1 + k'_idx" 0]
    by auto
qed

lemma str_ord_eq1 :
  assumes "l1 = l2"
  shows
    "map_of l1 k = map_of l2 k"
  using assms
  by auto

lemma str_ord_eq2 :
  assumes H1 : "strict_order (map fst l1)"
  assumes H2 : "strict_order (map fst l2)"
  assumes H : "\<And> k . map_of l1 k = map_of l2 k"
  shows "l1 = l2" using assms
proof(induction l1 arbitrary: l2)
  case Nil
  show ?case
  proof(cases l2)
    case Nil' : Nil
    then show ?thesis using Nil by auto
  next
    case Cons' : (Cons l2h l2t)

    obtain l2hk l2hv where L2h : "l2h = (l2hk, l2hv)"
      by(cases l2h; auto)

    have False using Nil(3)[of l2hk] L2h Cons'
      by(auto)

    then show ?thesis by auto
  qed
next
  case (Cons l1h l1t)

  obtain l1hk l1hv where L1h : "l1h = (l1hk, l1hv)"
    by(cases l1h; auto)

  show ?case
  proof(cases l2)
    case Nil' : Nil
    then show ?thesis using Cons.prems(3)[of "l1hk"] L1h
      by auto
  next
    case Cons' : (Cons l2h l2t)

    obtain l2hk l2hv where L2h : "l2h = (l2hk, l2hv)"
      by(cases l2h; auto)

    consider (1) "l1hk < l2hk" |
             (2) "l2hk < l1hk" |
             (3) "l1hk = l2hk"
      using linorder_class.less_linear
      by auto

    then show ?thesis
    proof cases
      case 1

      have L1hv : "map_of (l1h # l1t) l1hk = Some l1hv"
        using L1h
        by auto

      hence L2v : "map_of l2t l1hk = Some l1hv"
        using Cons.prems(3)[of l1hk] 1 L2h Cons' by auto

      hence L2v' : "l1hk \<in> set (map fst l2t)"
        using imageI[OF map_of_SomeD[OF L2v], of fst]
        by auto

      then have False using strict_order_cons'[of l2hk "map fst l2t" "l1hk"] 1
        Cons.prems(2) Cons' L2h
        by auto

      then show ?thesis
        by auto
    next
      case 2

      have L2hv : "map_of l2 l2hk = Some l2hv"
        using L2h Cons'
        by auto

      hence L1v : "map_of (l1h # l1t) l2hk = Some l2hv"
        using Cons.prems(3)[of l2hk]
        by auto

      hence L1v' : "map_of l1t l2hk = Some l2hv"
        using 2 L1h
        by(auto split: if_split_asm)

      hence L1v'' : "l2hk \<in> set (map fst (l1t))"
        using imageI[OF map_of_SomeD[OF L1v'], of fst]
        by auto

      then have False using strict_order_cons'[of l1hk "map fst (l1t)" "l2hk"] 2
        Cons.prems(1) Cons' L1h
        by auto

      then show ?thesis
        by auto
    next
      case 3

      have Ord1' : "strict_order (map fst l1t)"
        using strict_order_tl Cons.prems(1) L1h
        by auto

      have Ord2' : "strict_order (map fst l2t)"
        using strict_order_tl Cons.prems(2) L2h Cons'
        by auto

      have Ind_Arg : " (\<And>k. map_of l1t k = map_of l2t k)"
      proof-
        fix k

        show "map_of l1t k = map_of l2t k"
        proof(cases "k = l1hk")
          case True

          have C1 : "map_of l1t k = None"
          proof(cases "map_of l1t k")
            case None
            then show ?thesis by simp
          next
            case (Some bad)

            have Bad1 :  "(k, bad) \<in> set l1t"
              using map_of_SomeD[OF Some] by simp

            hence Bad2 : "k \<in> set (map fst l1t)"
              using imageI[OF Bad1, of fst]
              by simp

            then have False
              using strict_order_cons'[of l1hk "map fst l1t", of k] Cons.prems(1) L1h True
              by auto

            thus ?thesis by auto
          qed

          have C2 : "map_of l2t k = None"
          proof(cases "map_of l2t k")
            case None
            then show ?thesis by simp
          next
            case (Some bad)

            have Bad1 :  "(k, bad) \<in> set l2t"
              using map_of_SomeD[OF Some] by simp

            hence Bad2 : "k \<in> set (map fst l2t)"
              using imageI[OF Bad1, of fst]
              by simp

            then have False
              using strict_order_cons'[of l2hk "map fst l2t", of k] Cons.prems(2) True 3 L2h Cons'
              by auto

            thus ?thesis by auto
          qed

          show "map_of l1t k = map_of l2t k"
            using C1 C2
            by auto
        next
          case False

          then show "map_of l1t k = map_of l2t k"
            using Cons.prems(3)[of k] 3 L2h L1h Cons'
            by(simp)
        qed
      qed

      have Vs : "l1hv = l2hv"
        using Cons.prems(3)[of l1hk] 3 L1h L2h Cons'
        by auto

      show ?thesis
        using Cons.IH[OF Ord1' Ord2' Ind_Arg] Cons.prems 3 L1h L2h Cons' Vs
        by auto
    qed
  qed
qed

lemma oalist_eq2 :
  assumes H : "\<And> k . get l1 k = get l2 k"
  shows "l1 = l2" using assms
proof(transfer)
  show "\<And>l1 l2.
       strict_order (map fst l1) \<Longrightarrow>
       strict_order (map fst l2) \<Longrightarrow>
       (\<And>k. map_of l1 k = map_of l2 k) \<Longrightarrow> l1 = l2"
    using str_ord_eq2
    by blast
qed

lemma oalist_get_eq :
  shows "(l1 = l2) = (\<forall> k . get l1 k = get l2 k)"
  using oalist_eq2
  by blast

lemma alist_map_val_get :
  shows
  "map_of (alist_map_val f l) k =
      (case map_of l k of
        None \<Rightarrow> None
        | Some v \<Rightarrow> Some (f v))"
proof(induction l arbitrary: f k)
  case Nil
  then show ?case by auto
next
  case (Cons lh lt)
  then show ?case
    by(auto)
qed

lemma oalist_map_val_get :
  shows "get (oalist_map_val f l) k =
    (case get l k of
      None \<Rightarrow> None
      | Some v \<Rightarrow> Some (f v))"
proof(transfer)
  fix f l k
  show "strict_order (map fst l) \<Longrightarrow>
        map_of (alist_map_val f l) k =
        (case map_of l k of None \<Rightarrow> None | Some v \<Rightarrow> Some (f v))"
    using alist_map_val_get[of f l k]
    by auto
qed

lemma oalist_keys_update_hit :
  fixes l :: "('k :: linorder, 'v) oalist"
  assumes "get l k = Some v"
  shows "oalist_keys (update k v' l) = oalist_keys l"
  using assms
proof(transfer)
  fix l :: "('k * 'v) list"
  show "\<And> k v v'.
       strict_order (map fst l) \<Longrightarrow>
       map_of l k = Some v \<Longrightarrow>
       map fst (str_ord_update k v' l) = map fst l"
  proof(induction l)
    case Nil
    then show ?case
      by(auto)
  next
    case (Cons h t)

    obtain hk hv where H: "h = (hk, hv)"
      by(cases h; auto)

    have Ord_tl : "strict_order (map fst t)"
      using Cons.prems strict_order_tl
      by auto

    show ?case
    proof(cases "k = hk")
      case Eq : True
      then show ?thesis using Cons H
        by(auto)
    next
      case False

      show ?thesis
      proof(cases "hk < k")
        case Lt : True
        then show ?thesis
          using Cons.prems H Cons.IH[OF Ord_tl]
          by(auto)
      next
        case Bad : False

        have Map_tl : "map_of (t) k = Some v"
          using Cons.prems False H
          by(auto)

        then have "(k, v) \<in> set t"
          using map_of_SomeD[OF Map_tl]
          by auto

        then obtain ix where Ix :
          "t ! ix = (k, v)" "ix < length t"
          unfolding in_set_conv_nth
          by auto

        then show ?thesis
          using False Bad H strict_order_unfold[OF Cons.prems(1), of "1 + ix" 0]
          by(auto)
      qed
    qed
  qed
qed

lemma str_ord_update_get_eq :
  assumes "strict_order (map fst l)"
  shows "map_of (str_ord_update k v l) k = Some v"
  using assms
proof(induction l arbitrary: k v)
  case Nil
  then show ?case
    by(auto)
next
  case (Cons h t)

  obtain hk hv where H : "h = (hk, hv)"
    by(cases h; auto)

  show ?case using Cons H strict_order_tl
    by(auto)
qed

lemma oalist_update_get_eq :
  fixes l :: "('k :: linorder, 'v) oalist"
  shows "get (update k v l) k = Some v"
proof(transfer)
  fix k v
  fix l :: "('k * 'v) list"
  assume H : "strict_order (map fst l)"
  show "map_of (str_ord_update k v l)
        k =
       Some v"
    using str_ord_update_get_eq[OF H]
    by auto
qed

lemma str_ord_update_get_neq :
  assumes "strict_order (map fst l)"
  assumes "k1 \<noteq> k"
  shows "map_of (str_ord_update k1 v l) k =
         map_of l k"
  using assms
proof(induction l arbitrary: k v)
  case Nil
  then show ?case
    by(auto)
next
  case (Cons h t)

  obtain hk hv where H : "h = (hk, hv)"
    by(cases h; auto)

  show ?case using Cons H strict_order_tl
    by(auto)
qed

lemma oalist_update_get_neq :
  fixes l :: "('k :: linorder, 'v) oalist"
  assumes "k1 \<noteq> k"
  shows "get (update k1 v l) k = get l k"
  using assms
proof(transfer)
  fix k1 k :: 'k
  fix v
  fix l :: "('k * 'v) list"
  assume Neq : "k1 \<noteq> k"
  assume H : "strict_order (map fst l)"
  show "map_of (str_ord_update k1 v l)
        k =
       map_of l k"
    using str_ord_update_get_neq[OF H Neq]
    by auto
qed

lemma oalist'_one_one_tl :
  assumes "distinct (map snd (h#t))"
  shows "distinct (map snd t)"
  using assms
  by(auto)

lemma oalist_flip'_get :
  fixes l :: "('k :: linorder * 'k) list"
  assumes "strict_order (map fst l)"
  assumes "distinct (map snd l)"
  assumes "map_of l k = Some v"
  shows "map_of (oalist_flip' l) v = Some k"
  using assms
proof-
  fix l :: "('k * 'k) list"
  show "\<And> k v.
       strict_order (map fst l) \<Longrightarrow>
       distinct (map snd l) \<Longrightarrow>
       map_of l k = Some v \<Longrightarrow>
       map_of (oalist_flip' l) v = Some k"
  proof(induction l)
    case Nil
    then show ?case by auto
  next
    case (Cons h t)

    obtain hk hv where H : "h = (hk, hv)"
      by(cases h; auto)

    have Ord_tl : "strict_order (map fst t)"
      using Cons.prems H strict_order_tl
      by auto

    have Ord_flip : "strict_order (map fst (oalist_flip' t))"
      using Ord_tl oalist_flip'_correct
      by auto

    show ?case
    proof(cases "k = hk")
      case True

      then show ?thesis
        using Cons.prems Cons.IH H str_ord_update_get_eq[OF Ord_flip, of v hk]
        by(auto)
    next
      case False

      have Map_tl : "map_of t k = Some v"
        using Cons.prems H False
        by(auto)

      have Vin : "v \<in> snd ` set t"
        using imageI[OF map_of_SomeD[OF Map_tl], of snd]
        by(auto)

      have Hv_notin : "hv \<notin> snd ` set t"
        using Cons.prems False H
        by(auto)

      have Neq : "hv \<noteq> v"
        using Vin Hv_notin
        by auto

      show ?thesis
        using Cons.prems Cons.IH[OF Ord_tl, of k v] H str_ord_update_get_neq[OF Ord_flip Neq] False
        by(auto)
    qed
  qed
qed

lemma oalist_flip_get :
  fixes l :: "('k :: linorder, 'k) oalist"
  assumes "oalist_one_one l"
  assumes "get l k = Some v"
  shows "get (oalist_flip l) v = Some k"
  using assms
proof(transfer)
  fix l :: "('k * 'k) list"
  show "\<And> k v.
       strict_order (map fst l) \<Longrightarrow>
       distinct (map snd l) \<Longrightarrow>
       map_of l k = Some v \<Longrightarrow>
       map_of (oalist_flip' l) v = Some k"
    using oalist_flip'_get
    by auto
qed

lemma strict_order_update_swap :
  assumes "strict_order (map fst l)"
  assumes "k1 \<noteq> k2"
  shows "str_ord_update k1 v1 (str_ord_update k2 v2 l) =
         str_ord_update k2 v2 (str_ord_update k1 v1 l)"
  using assms
proof(induction l arbitrary: k1 v1 k2 v2)
  case Nil
  then show ?case
    using less_linear[of k1 k2]
    by(auto)
next
  case (Cons h t)

  obtain hk hv where H : "h = (hk, hv)"
    by(cases h; auto)

  have Ord_tl : "strict_order (map fst t)"
    using strict_order_tl Cons.prems
    by fastforce

  show ?case using Cons.prems Cons.IH[OF Ord_tl] H
    by(auto)
qed

lemma oalist_update_swap :
  fixes l :: "('k :: linorder, 'v) oalist"
  assumes "k1 \<noteq> k2"
  shows "update k1 v1 (update k2 v2 l) =
    update k2 v2 (update k1 v1 l)"
  using assms
proof(transfer)
  fix k1 k2 :: 'k
  fix v1 v2
  fix l :: "('k * 'v) list"
  assume Neq :
    "k1 \<noteq> k2"
  assume Ord :
    "strict_order (map fst l)"

  show "str_ord_update k1 v1 (str_ord_update k2 v2 l) =
       str_ord_update k2 v2 (str_ord_update k1 v1 l)"
    using strict_order_update_swap[OF Ord Neq]
    by auto
qed

lemma oalist_flip'_update :
  assumes H : "strict_order (map fst l)"
  assumes Hdist : "distinct (map snd l)"
  assumes "k \<notin> fst ` set l"
  assumes "v \<notin> snd ` set l"
  shows "oalist_flip' (str_ord_update k v l) =
         str_ord_update v k (oalist_flip' l)"
  using assms
proof(induction l arbitrary: k v)
  case Nil
  then show ?case
    by auto
next
  case (Cons h t)

  obtain hk hv where H : "h = (hk, hv)"
    by(cases h; auto)

  have Ord_tl : "strict_order (map fst t)"
    using strict_order_tl Cons.prems
    by fastforce

  show ?case
  proof(cases "k = hk")
    case True

    show ?thesis
      using Cons.prems H True
      by(auto)
  next
    case False
    then show ?thesis
      using Cons.prems H Cons.IH[OF Ord_tl, of k]
      using strict_order_update_swap[OF oalist_flip'_correct[OF Ord_tl]]
      by(auto)
  qed
qed

lemma str_ord_update_set :
  fixes l :: "('k :: linorder * 'k) list"
  assumes "strict_order (map fst l)"
  shows "set (str_ord_update k v l) =
    ((set l - {x . fst x = k}) \<union> {(k, v)})"
  using assms
proof(induction l arbitrary: k v)
  case Nil
  then show ?case by auto
next
  case (Cons h t)

  obtain hk hv where H: "h = (hk, hv)"
    by(cases h; auto)

  have Ord_tl : "strict_order (map fst t)"
    using Cons.prems H strict_order_tl
    by auto

  show ?case
  proof(cases "hk = k")
    case True

    then show ?thesis
      using Cons.prems Cons.IH[OF Ord_tl] H
      using strict_order_distinct[OF Cons.prems(1)]
      by(auto)
  next
    case False1 : False

    show ?thesis
    proof(cases "hk < k")
      case True2 : True

      then show ?thesis
        using Cons.prems Cons.IH[OF Ord_tl] H
        using strict_order_distinct[OF Cons.prems(1)]
        by(auto)

    next

      case False2 : False

      have Lt : "k < hk"
        using False1 False2
        by auto

      show ?thesis
      proof
        show "set (str_ord_update k v (h # t))
          \<subseteq> set (h # t) - {x. fst x = k} \<union> {(k, v)}"
        proof
          fix x

          assume X : "x \<in> set (str_ord_update k v (h # t))"

          obtain xk xv where Xkv : "x = (xk, xv)"
            by(cases x; auto)

          show "x \<in> set (h # t) - {x. fst x = k} \<union> {(k, v)}"
          proof(cases "xk = k")
            case True3 : True

            show ?thesis
            proof(cases "(k, xv) \<in> set t")
              case True4 : True

              then obtain ix where Ix : "t ! ix = (k, xv)" "ix < length t"
                unfolding in_set_conv_nth
                by auto

              have False
                using strict_order_unfold[OF Cons.prems(1), of "1 + ix" "0"]
                using H Lt X Xkv Ix
                by(auto)

              then show ?thesis by auto
            next
              case False4 : False
              then show ?thesis
                using Cons.prems Cons.IH[OF Ord_tl] H Lt X Xkv
                using strict_order_distinct[OF Cons.prems(1)]
                by(auto)
            qed
          next
            case False3 : False
            then show ?thesis
              using Cons.prems Cons.IH[OF Ord_tl] H Lt X Xkv
              using strict_order_distinct[OF Cons.prems(1)]
              by(auto)
          qed
        qed
      next
        show "set (h # t) - {x. fst x = k} \<union> {(k, v)}
          \<subseteq> set (str_ord_update k v (h # t))"
        using Cons.prems Cons.IH[OF Ord_tl] H
        using strict_order_distinct[OF Cons.prems(1)]
          by(auto)
      qed
    qed
  qed
qed

lemma oalist_flip'_set :
  fixes l :: "('k :: linorder * 'k) list"
  assumes "strict_order (map fst l)"
  assumes "distinct (map snd l)"
  shows "set (oalist_flip' l) = (\<lambda> (x, y) . (y, x)) ` set l"
  using assms
proof(induction l)
  case Nil
  then show ?case by auto
next
  case (Cons h t )

  obtain hk hv where H: "h = (hk, hv)"
    by(cases h; auto)

  have Ord_tl : "strict_order (map fst t)"
    using Cons.prems H strict_order_tl
    by auto

  show ?case
  proof
    show "set (oalist_flip' (h # t)) \<subseteq> (\<lambda>a. case a of (x, y) \<Rightarrow> (y, x)) ` set (h # t)"
    proof
      fix x
      assume Hx : "x \<in> set (oalist_flip' (h # t)) "

      obtain xk xv where Xkv : "x = (xv, xk)"
        by(cases x; auto)

      have In_upd : "(xv, xk) \<in> set (str_ord_update hv hk (oalist_flip' t))"
        using Cons.prems Cons.IH[OF Ord_tl] H Hx Xkv
        by(auto)

      have In_upd' : "(xv, xk) \<in> set (oalist_flip' (t)) - {x. fst x = hv} \<union> {(hv, hk)}"
        using In_upd
        unfolding Xkv str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl], of hv hk]
          In_upd Xkv
        by simp

      show "x \<in> (\<lambda>a. case a of (x, y) \<Rightarrow> (y, x)) ` set (h # t)"
      proof(cases "hv \<in> snd ` set t")
        case True
        then show ?thesis
          using Cons.prems Cons.IH[OF Ord_tl] H Hx Xkv
          using str_ord_update_get_eq[OF oalist_flip'_correct[OF Ord_tl]]
          by(auto)
      next
        case False
        then show ?thesis
          using Cons.prems Cons.IH[OF Ord_tl] H Hx Xkv In_upd'
          by(auto)
      qed
    qed
  next
    show "(\<lambda>a. case a of (x, y) \<Rightarrow> (y, x)) ` set (h # t) \<subseteq> set (oalist_flip' (h # t))"
    proof
      fix x
      assume Hx : "x \<in> (\<lambda>a. case a of (x, y) \<Rightarrow> (y, x)) ` set (h # t)"

      obtain xk xv where Xkv : "x = (xv, xk)"
        by(cases x; auto)

      show "x \<in> set (oalist_flip' (h # t))"
      proof(cases "xk = hk")
        case True

        show ?thesis
          using Cons.prems H  Hx Xkv True Cons.IH[OF Ord_tl]
          using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl]]
          by(auto)
      next
        case False
        show ?thesis
        proof(cases "xv = hv")
          case True2 : True

          have In_t' : "(xk, hv) \<in> set t"
            using Cons.prems H  Hx Xkv False True2 Cons.IH[OF Ord_tl]
            using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl]]
            by(auto)

          have "hv \<in> snd ` set t"
            using imageI[OF In_t', of snd]
            by auto

          then show ?thesis
            using Cons.prems H  Hx Xkv False True2 Cons.IH[OF Ord_tl]
            using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl]]
            by(auto)
        next
          case False2 : False
          show ?thesis
            using Cons.prems H  Hx Xkv False False2 Cons.IH[OF Ord_tl]
            using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl]]
            by(auto)
        qed
      qed
    qed
  qed
qed

lemma str_ord_update_concat :
  fixes l :: "('k :: linorder * 'v) list"
  assumes "strict_order (map fst l)"
  assumes "k \<notin> fst ` set l"
  shows "\<exists> pre post .
    str_ord_update k v l =
      pre @ [(k, v)] @ post \<and>
    l = pre @ post"
  using assms
proof(induction l arbitrary: k v)
  case Nil
  then show ?case by auto
next
  case (Cons h t )

  obtain hk hv where H: "h = (hk, hv)"
    by(cases h; auto)

  have Ord_tl : "strict_order (map fst t)"
    using Cons.prems H strict_order_tl
    by auto

  show ?case
  proof(cases "hk < k")
    case True

    have Notin' : "k \<notin> fst ` set t"
      using Cons.prems
      by auto

    obtain pre0 post0 where Ind :
      "str_ord_update k v t = pre0 @ (k, v) # post0" "t = pre0 @ post0"
      using Cons.prems H Cons.IH[OF Ord_tl Notin', of v]
      by auto

    have Conc' : "str_ord_update k v (h # t) = (h # pre0) @ [(k, v)] @ post0 \<and> h # t = (h # pre0) @ post0"
      using Ind H True
      by(auto)

    then show ?thesis
      by blast
  next
    case False
    then show ?thesis
      using Cons.prems H
      by(auto)
  qed
qed

lemma oalist_flip'_map_snd :
  fixes l :: "('k :: linorder * 'k) list"
  assumes "strict_order (map fst l)"
  assumes "distinct (map snd l)"
  shows "distinct (map snd (oalist_flip' l))"
  using assms
proof(induction l)
  case Nil
  then show ?case by auto
next
  case (Cons h t )

  obtain hk hv where H: "h = (hk, hv)"
    by(cases h; auto)

  have Ord_tl : "strict_order (map fst t)"
    using Cons.prems H strict_order_tl
    by auto

  have Dist_tl : "distinct (map snd t)"
    using Cons.prems H
    by auto

  have Hk_notin : "hk \<notin> fst ` set t"
    using strict_order_distinct[OF Cons.prems(1)] H
    by(auto)

  have Hv_notin : "hv \<notin> fst ` set (oalist_flip' t)"
    using oalist_flip'_set[OF Ord_tl Dist_tl] H Cons.prems
    apply(auto)
    apply(drule_tac f = snd in imageI)
    apply(auto)
    done

  have Hk_notin' : "hk \<notin> snd ` set (oalist_flip' t)"
    using oalist_flip'_set[OF Ord_tl Dist_tl] H Cons.prems Hk_notin
    apply(auto)
    apply(drule_tac f = fst in imageI)
    apply(auto)
    done

  obtain pre post where Split :
    "(str_ord_update hv hk (oalist_flip' t)) =
     pre @ [(hv, hk)] @ post" "oalist_flip' t = pre @ post"
    using str_ord_update_concat[OF oalist_flip'_correct[OF Ord_tl] Hv_notin]
    by blast

  have Conc' : "distinct (map snd (pre @ [(hv, hk)] @ post))"
    unfolding map_append distinct_append
    using Cons.prems Split(2) Cons.IH[OF Ord_tl Dist_tl] H
    using oalist_flip'_set[OF Ord_tl Dist_tl] Hk_notin'
    by(auto)

  have Conc'' : "distinct
     (map snd
       (str_ord_update hv hk (oalist_flip' t)))"
    using Conc'
    unfolding Split(1)
    by auto

  show ?case
    using Cons.prems Cons.IH[OF Ord_tl] H
    using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl], of hv hk]
    using Conc''
    by(auto)
qed

lemma oacons'_cons :
  assumes Cons' : "oacons' kh vh l = Some l'"
  shows "l' = ((kh, vh)#l)"
proof(cases l)
  case Nil
  then show ?thesis using Cons'
    by(auto)
next
  case (Cons a list)
  then show ?thesis
    using Cons'
    by(cases a; auto split: if_splits)
qed

lemma get_cons :
  fixes l l' :: "('k :: linorder, 'v) oalist"
  assumes "oacons kh vh l = Some l'"
  assumes "get l k = Some v"
  shows "get l' k = Some v"
  using assms
proof(transfer)
  fix l :: "('k :: linorder * 'v) list"
  show "\<And>kh vh l' k v.
       strict_order (map fst l) \<Longrightarrow>
       strict_order (map fst l') \<Longrightarrow>
       oacons' kh vh l = Some l' \<Longrightarrow>
       map_of l k = Some v \<Longrightarrow> map_of l' k = Some v"
  proof(induction l)
    case Nil
    then show ?case
      by(auto)
  next
    case (Cons h' t')

    obtain kh' vh' where H' : "h' = (kh', vh')"
      by(cases h'; auto)

    have Ord' : "strict_order (map fst t')"
      using Cons.prems strict_order_tl H'
      by(fastforce)

    have Oacons' : "oacons' kh' vh' t' = Some (h' # t')"
      using oacons'_destruct Cons.prems unfolding H'
      by(fastforce)

    have L' : "l' = ((kh,  vh) # (kh', vh') # t')"
      using Cons.prems oacons'_cons H'
      by(fastforce)

    have Lt : "kh < kh'"
      using strict_order_unfold[OF Cons.prems(2), of 1 0] L'
      by(auto)

    have Notin : "map_of t' kh = None"
    proof(cases "map_of t' kh")
      case None
      then show ?thesis by auto
    next
      case (Some vbad)
      then have In_bad : "(kh, vbad) \<in> set t'"
        using map_of_SomeD
        by fastforce

      have In_bad2 : "kh \<in> fst ` set t'"
        using imageI[OF In_bad, of fst]
        by auto

      then have False
        using strict_order_distinct[OF Cons.prems(2)] H'
        unfolding L'
        by(auto)

      then show ?thesis by auto

    qed

    show ?case
      using Cons.prems H' L' Lt Notin
      by(cases "kh = kh'"; auto)
  qed
qed

lemma get_tl :
  fixes l l' :: "('k :: linorder, 'v) oalist"
  assumes "oacons kh vh l = Some l'"
  assumes "get l' k = Some v"
  assumes "k \<noteq> kh"
  shows "get l k = Some v"
  using assms
proof(transfer)
  fix l :: "('k :: linorder * 'v) list"
  show "\<And>kh vh l l' k v .
       strict_order (map fst l) \<Longrightarrow>
       strict_order (map fst l') \<Longrightarrow>
       oacons' kh vh l = Some l' \<Longrightarrow>
       map_of l' k = Some v \<Longrightarrow> k \<noteq> kh \<Longrightarrow> map_of l k = Some v"
  proof(induction l)
    case Nil
    have L' : "l' = ((kh, vh)#l)"
      using Nil oacons'_cons
      by fastforce

    then show ?case using Nil
      by(auto)
  next
    case (Cons h' t')

    have L' : "l' = ((kh, vh)#l)"
      using Cons.prems oacons'_cons
      by fastforce

    show ?case using Cons.prems unfolding L'
      by(auto)
  qed
qed

lemma get_hd :
  fixes l :: "('k :: linorder, 'v) oalist"
  assumes "oacons kh vh l = Some l'"
  shows "get l' kh = Some vh"
  using assms
proof(transfer)
  fix l :: "('k * 'v) list"
  show "\<And>kh vh l'.
       strict_order (map fst l) \<Longrightarrow>
       strict_order (map fst l') \<Longrightarrow>
       oacons' kh vh l = Some l' \<Longrightarrow>
       map_of l' kh = Some vh"
  proof(induction l)
    case Nil
    then show ?case
      by(auto)
  next
    case (Cons lh lt)
    then show ?case
      by(cases lh; auto split: if_splits)
  qed
qed

lemma oalist_keys_get_Some :
  fixes l1 :: "('k :: linorder, 'v) oalist"
  assumes "oalist_keys l1 = oalist_keys l2"
  assumes "get l1 k = Some v"
  shows "\<exists> v' . get l2 k = Some v'"
  using assms
proof(transfer)
  fix l1 :: "('k * 'v) list"
  show "\<And>l2 k v.
       strict_order (map fst l1) \<Longrightarrow>
       strict_order (map fst l2) \<Longrightarrow>
       map fst l1 = map fst l2 \<Longrightarrow>
       map_of l1 k = Some v \<Longrightarrow>
       \<exists>v'. map_of l2 k = Some v'"
  proof(induction l1)
    case Nil
    then show ?case
      by(auto)
  next
    case Cons1 : (Cons h1 t1)

    obtain h1k h1v
      where H1 : "h1 = (h1k, h1v)"
      by(cases h1; auto)

    obtain h2 t2
      where Cons2 : "l2 = h2 # t2"
      using Cons1.prems
      by(auto)

    obtain h2k h2v where
      H2 : "(h2 = (h2k, h2v))"
      by(cases h2; auto)

    show ?case
    proof(cases "k = h1k")
      case True
      then show ?thesis
        using Cons1.prems Cons2 H1 H2
        by(auto)
    next
      case False

      have Get_t1 : "map_of t1 k = Some v"
        using Cons1.prems H1 Cons2 H2 False
        by(auto)

      have Ord_tl1 : "strict_order (map fst t1)"
        using strict_order_tl Cons1.prems H1 False
        by(fastforce)

      then show ?thesis
        using Cons1.prems H1 Cons2 H2
        using Cons1.IH
        by(auto)
    qed

  qed
qed

lemma oalist_keys_get_None :
  fixes l1 :: "('k :: linorder, 'v) oalist"
  assumes "oalist_keys l1 = oalist_keys l2"
  assumes "get l1 k = None"
  shows "get l2 k = None"
  using assms
proof(transfer)
  fix l1 :: "('k * 'v) list"
  show "\<And>l2 k.
       strict_order (map fst l1) \<Longrightarrow>
       strict_order (map fst l2) \<Longrightarrow>
       map fst l1 = map fst l2 \<Longrightarrow>
       map_of l1 k = None \<Longrightarrow> map_of l2 k = None"
  proof(induction l1)
    case Nil
    then show ?case by auto
  next
    case Cons1 : (Cons h1 t1)

    obtain h1k h1v
      where H1 : "h1 = (h1k, h1v)"
      by(cases h1; auto)

    obtain h2 t2
      where Cons2 : "l2 = h2 # t2"
      using Cons1.prems
      by(auto)

    obtain h2k h2v where
      H2 : "(h2 = (h2k, h2v))"
      by(cases h2; auto)

    show ?case
    proof(cases "k = h1k")
      case True
      then show ?thesis
        using Cons1.prems Cons2 H1 H2
        by(auto)
    next
      case False

      have Get_t1 : "map_of t1 k = None"
        using Cons1.prems H1 Cons2 H2 False
        by(auto)

      have Ord_tl1 : "strict_order (map fst t1)"
        using strict_order_tl Cons1.prems H1 False
        by(fastforce)

      then show ?thesis
        using Cons1.prems H1 Cons2 H2
        using Cons1.IH
        by(auto)
    qed
  qed
qed

lemma get_to_oalist :
  fixes l :: "('k :: linorder * 'v) list"
  assumes "distinct (map fst l)"
  shows "get (to_oalist l) k = map_of l k"
  using assms
proof(induction l arbitrary: k)
  case Nil
  then show ?case using empty_get
    by(auto)
next
  case (Cons h t)

  obtain hk hv where H : "h = (hk, hv)"
    by(cases h; auto)

  show ?case
  proof(cases "k = hk")
    case True
    then show ?thesis using Cons H oalist_update_get_eq[of hk hv "to_oalist t"]
      by(auto)
  next
    case False
    then show ?thesis using Cons H oalist_update_get_neq[of hk k hv]
      by(auto)
  qed
qed

lemma oalist_keys_update_eq :
  fixes l1 :: "('k :: linorder, 'v1) oalist"
  fixes l2 :: "('k :: linorder, 'v2) oalist"
  assumes "oalist_keys l1 = oalist_keys l2"
  shows "oalist_keys (update n v1 l1) = oalist_keys (update n v2 l2)"
  using assms
proof(transfer)
  fix l1 :: "('k :: linorder * 'v1) list"
  show "\<And> (l2 :: ('k :: linorder * 'v2) list) n v1 v2 .
       strict_order (map fst l1) \<Longrightarrow>
       strict_order (map fst l2) \<Longrightarrow>
       map fst l1 = map fst l2 \<Longrightarrow>
       map fst (str_ord_update n v1 l1) = map fst (str_ord_update n v2 l2)"
  proof(induction l1)
    case Nil
    then show ?case
      by(auto)
  next
    case (Cons l1h l1t)

    obtain hk l1hv where L1h : "l1h = (hk, l1hv)"
      by(cases l1h; auto)

    obtain l2h l2t where Cons' : "l2 = l2h # l2t"
      using Cons.prems
      by(cases l2; auto)

    obtain l2hv where L2h : "l2h = (hk, l2hv)"
      using Cons.prems L1h Cons'
      by(cases l2h; auto)

    show ?case
    proof(cases "hk < n")
      case True

      have Ord_tl1 : "strict_order (map fst l1t)"
        using strict_order_tl Cons.prems
        by auto

      have Ord_tl2 : "strict_order (map fst l2t)"
        using strict_order_tl Cons.prems Cons'
        by auto

      show ?thesis
        using Cons.prems L1h Cons' L2h True
        using Cons.IH[OF Ord_tl1 Ord_tl2]
        by(auto)
    next
      case False
      then show ?thesis using Cons.prems L1h Cons' L2h
        by(auto)
    qed
  qed
qed

lemma oalist_flip_update :
  fixes l :: "('k :: linorder, 'k) oalist"
  assumes "oalist_one_one l"
  assumes "k \<notin> set (oalist_keys l)"
  assumes "v \<notin> set (oalist_keys (oalist_flip l))"
  shows "oalist_flip (update k v l) = update v k (oalist_flip l)"
  using assms
proof(transfer)
  fix l :: "('k :: linorder * 'k) list"
  fix k v
  assume Ord : "strict_order (map fst l)"
  assume Dist : "distinct (map snd l)"
  assume Notin1 : "k \<notin> set (map fst l)"
  assume Notin2 : "v \<notin> set (map fst (oalist_flip' l))"

  have Notin1' : "k \<notin> fst ` set l"
    using Notin1 by auto

  have Fst_flip : "fst o (\<lambda>(x, y). (y, x)) = snd"
  proof
    fix w
    show "(fst \<circ> (\<lambda>(x, y). (y, x))) w = snd w"
      by(cases w; auto)
  qed

  have Notin2_alt : "v \<notin> fst ` set (oalist_flip' l)"
    using Notin2
    by auto

  hence "v \<notin> fst ` (\<lambda>(x, y). (y, x)) ` set l"
    using oalist_flip'_set[OF Ord Dist]
    by auto

  hence "v \<notin> (fst o (\<lambda>(x, y). (y, x))) ` set l"
    by auto

  hence Notin2' : "v \<notin> snd ` set l"
    unfolding Fst_flip by auto

  show "oalist_flip' (str_ord_update k v l) = str_ord_update v k (oalist_flip' l)"
    using oalist_flip'_update[OF Ord Dist Notin1' Notin2']
    by auto
qed

lemma oalist_one_one_update :
  fixes l :: "('k :: linorder, 'k) oalist"
  assumes "oalist_one_one l"
  assumes "k \<notin> set (oalist_keys l)"
  assumes "v \<notin> set (oalist_keys (oalist_flip l))"
  shows "oalist_one_one (update k v l)"
  using assms
proof(transfer)
  fix l :: "('k * 'k) list"
  show "\<And> v k.
       strict_order (map fst l) \<Longrightarrow>
       distinct (map snd l) \<Longrightarrow>
       k \<notin> set (map fst l) \<Longrightarrow>
       v \<notin> set (map fst (oalist_flip' l)) \<Longrightarrow> distinct (map snd (str_ord_update k v l))"
  proof(induction l)
    case Nil
    then show ?case
      by(auto)
  next
    case (Cons lh lt)

    obtain lhk lhv where Lh : "lh = (lhk, lhv)"
      by(cases lh; auto)

    have Ord_tl : "strict_order (map fst lt)"
      using strict_order_tl Cons.prems
      by auto

    show ?case
    proof(cases "k < lhk")
      case K_lt : True

      show ?thesis
      proof(cases "v = lhv")
        case V_eq : True

        have Lhv_notin : "lhv \<notin> fst ` set (str_ord_update lhv lhk (oalist_flip' lt))"
          using Cons Lh K_lt V_eq
          by(auto)

        then have Lhv_notin' : "lhv \<notin> fst ` (set (oalist_flip' lt) - {x. fst x = lhv} \<union> {(lhv, lhk)})"
          using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl], of lhv lhk]
          by auto

        then have False
          by auto

        then show ?thesis by auto
      next
        case V_neq : False

        have Fst_flip : "fst o (\<lambda>(x, y). (y, x)) = snd"
        proof
          fix w
          show "(fst \<circ> (\<lambda>(x, y). (y, x))) w = snd w"
            by(cases w; auto)
        qed

        have V_notin : "v \<notin> fst ` set (str_ord_update lhv lhk (oalist_flip' lt))"
          using Cons.prems Lh K_lt V_neq
          by auto

        then have V_notin' : "v \<notin> fst ` (set (oalist_flip' lt) - {x. fst x = lhv} \<union> {(lhv, lhk)})"
          using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl], of lhv lhk]
          by auto

        then have V_notin_tl : "v \<notin> fst ` set (oalist_flip' lt)"
          by auto

        then have "v \<notin> fst ` (\<lambda>(x, y). (y, x)) ` set lt"
          using oalist_flip'_set[OF Ord_tl] Cons.prems
          by auto

        then have "v \<notin> (fst o (\<lambda>(x, y). (y, x))) ` set lt"
          by auto

        then have "v \<notin> snd ` set lt"
          unfolding Fst_flip
          by auto

        then show ?thesis
          using Cons.prems Lh K_lt V_neq V_notin_tl
          by(auto)
      qed
    next
      case K_nlt : False

      show ?thesis
      proof(cases "k = lhk")
        case K_eq : True

        then have False
          using Cons.prems Lh
          by auto

        then show ?thesis by auto
      next
        case K_gt' : False

        have K_gt : "lhk < k"
          using K_nlt K_gt'
          by auto

        show ?thesis
        proof(cases "v = lhv")
          case V_eq : True

          have Lhv_notin : "lhv \<notin> fst ` set (str_ord_update lhv lhk (oalist_flip' lt))"
            using Cons Lh V_eq
            by(auto)

          then have Lhv_notin' : "lhv \<notin> fst ` (set (oalist_flip' lt) - {x. fst x = lhv} \<union> {(lhv, lhk)})"
            using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl], of lhv lhk]
            by auto

          then have False
            by auto

          then show ?thesis by auto
        next
          case V_neq : False

          have Lhv_notin : "lhv \<notin> snd ` set lt"
            using Cons.prems Lh V_neq
            by(auto)

          hence "lhv \<notin> snd ` (set lt - {x. fst x = k} \<union> {(k, v)})"
            using V_neq
            by auto

          hence Lhv_notin' : "lhv \<notin> snd ` set (str_ord_update k v lt)"
            using str_ord_update_set[OF Ord_tl]
            by auto

          have Fst_flip : "fst o (\<lambda>(x, y). (y, x)) = snd"
          proof
            fix w
            show "(fst \<circ> (\<lambda>(x, y). (y, x))) w = snd w"
              by(cases w; auto)
          qed

          have V_notin : "v \<notin> fst ` set (str_ord_update lhv lhk (oalist_flip' lt))"
            using Cons.prems Lh V_neq
            by auto

          then have V_notin' : "v \<notin> fst ` (set (oalist_flip' lt) - {x. fst x = lhv} \<union> {(lhv, lhk)})"
            using str_ord_update_set[OF oalist_flip'_correct[OF Ord_tl], of lhv lhk]
            by auto

          then have V_notin_tl : "v \<notin> fst ` set (oalist_flip' lt)"
            by auto

          show ?thesis
            using Cons.prems Lh K_gt V_neq Lhv_notin'
            using Cons.IH[OF Ord_tl, of k v] V_notin_tl
            by(auto)
        qed
      qed
    qed
  qed
qed

lemma oalist_keys_update_set :
  fixes l :: "('k :: linorder, 'v) oalist"
  shows "set (oalist_keys (update k v l)) = {k} \<union> set (oalist_keys l)"
proof(transfer)
  fix l :: "('k * 'v) list"
  show "\<And>k v .
       strict_order (map fst l) \<Longrightarrow>
       set (map fst (str_ord_update k v l)) = {k} \<union> set (map fst l)"
  proof(induction l)
    case Nil
    then show ?case by auto
  next
    case (Cons lh lt)

    obtain lhk lhv where Lh : "lh = (lhk, lhv)"
      by(cases lh; auto)

    show ?case
    proof(cases "k < lhk")
      case K_lt : True

      show ?thesis using Cons Lh K_lt
        by(auto)
    next
      case K_nlt : False

      show ?thesis
      proof(cases "k = lhk")
        case K_eq : True

        show ?thesis using Cons Lh K_eq
          by(auto)
      next
        case K_neq : False

        have K_gt : "lhk < k"
          using K_nlt K_neq
          by auto

        have Ord_tl : "strict_order (map fst lt)"
          using strict_order_tl Cons.prems
          by auto

        show ?thesis
          using Cons.prems Lh K_gt
          using Cons.IH[OF Ord_tl]
          by(auto)
      qed
    qed
  qed
qed

lemma str_ord_update_snd_distinct :
  fixes l :: "('k :: linorder * 'k) list"
  assumes "strict_order (map fst l)"
  assumes "distinct (map snd l)"
  assumes "k \<notin> set (map fst l)"
  assumes "v \<notin> set (map snd l)"
  shows "distinct (map snd (str_ord_update k v l))"
  using assms
proof(induction l arbitrary: k v)
  case Nil
  then show ?case
    by(auto)
next
  case (Cons lh lt)

  obtain lhk lhv where Lh :
    "lh = (lhk, lhv)"
    by(cases lh; auto)

  have Ord_tl : "strict_order (map fst lt)"
    using Cons.prems strict_order_tl
    by auto

  have Notin2' : "lhv \<notin> snd ` set (str_ord_update k v lt)"
    using Cons.prems Lh
    using str_ord_update_set[OF Ord_tl]
    by(auto)

  have Dist_tl : "distinct (map snd (str_ord_update k v lt))"
    using Cons.prems Lh Cons.IH[OF Ord_tl, of k v]
    by auto

  show ?case using Cons Lh Notin2' Dist_tl
    by(auto)
qed

lemma oalist_one_one_flip :
  fixes l :: "('k :: linorder, 'k) oalist"
  assumes "oalist_one_one l"
  shows "oalist_one_one (oalist_flip l)"
  using assms
proof(transfer)
  fix l :: "('k * 'k) list"
  show "strict_order (map fst l) \<Longrightarrow>
         distinct (map snd l) \<Longrightarrow> distinct (map snd (oalist_flip' l))"
    using oalist_flip'_map_snd
    by auto
qed

lemma oalist_flip_flip :
  fixes l :: "('k :: linorder, 'k) oalist"
  assumes "oalist_one_one l"
  shows "oalist_flip (oalist_flip l) = l"
  using assms
proof(transfer)
  fix l :: "('k * 'k) list"
  show "strict_order (map fst l) \<Longrightarrow>
         distinct (map snd l) \<Longrightarrow> oalist_flip' (oalist_flip' l) = l"
  proof(induction l)
    case Nil
    then show ?case by auto
  next
    case (Cons lh lt)

    obtain lhk lhv where Lh :
      "lh = (lhk, lhv)"
      by(cases lh; auto)

    have Ord_tl : "strict_order (map fst lt)"
      using strict_order_tl Cons.prems
      by auto

    have Flip_distinct_tl : " distinct (map snd (oalist_flip' lt))"
      using oalist_flip'_map_snd[OF Ord_tl] Cons.prems Lh
      by auto

    have Fst_flip : "fst o (\<lambda>(x, y). (y, x)) = snd"
    proof
      fix w
      show "(fst \<circ> (\<lambda>(x, y). (y, x))) w = snd w"
        by(cases w; auto)
    qed

    have Snd_flip : "snd o (\<lambda>(x, y). (y, x)) = fst"
    proof
      fix w
      show "(snd \<circ> (\<lambda>(x, y). (y, x))) w = fst w"
        by(cases w; auto)
    qed

    have Flip_set : "set (oalist_flip' lt) = (\<lambda>(x, y). (y, x)) ` set lt"
      using oalist_flip'_set[OF Ord_tl] Cons.prems Lh
      by auto

    have Notin1 : "lhv \<notin> snd ` set (lt)"
      using Cons.prems Lh by auto

    hence "lhv \<notin> (fst o (\<lambda>(x, y). (y, x))) ` set lt"
      unfolding sym[OF Fst_flip]
      by auto

    hence "lhv \<notin> fst ` (\<lambda>(x, y). (y, x)) ` set lt"
      unfolding image_comp
      by auto

    hence Notin1' : "lhv \<notin> fst ` set (oalist_flip' lt)"
      using Cons.prems Lh unfolding Flip_set
      by(auto)

    have Notin2 : "lhk \<notin> fst ` set lt"
      using strict_order_distinct[OF Cons.prems(1)] Cons.prems Lh
      by auto

    hence "lhk \<notin> (snd o (\<lambda>(x, y). (y, x))) ` set lt"
      unfolding sym[OF Snd_flip]
      by auto

    hence "lhk \<notin> snd ` (\<lambda>(x, y). (y, x)) ` set lt"
      unfolding image_comp
      by auto

    hence Notin2' : "lhk \<notin> snd ` set (oalist_flip' lt)"
      using Cons.prems Lh unfolding Flip_set
      by(auto)

    have Flip_update : "oalist_flip' (str_ord_update lhv lhk (oalist_flip' lt)) =
      str_ord_update lhk lhv (oalist_flip' (oalist_flip' lt))"
      using oalist_flip'_update[OF oalist_flip'_correct[OF Ord_tl] Flip_distinct_tl Notin1' Notin2']
      using Cons.prems Lh
      by(auto)

    have Conc' : "str_ord_update lhk lhv lt = (lhk, lhv) # lt"
    proof(cases lt)
      case Nil' : Nil
      then show ?thesis by auto
    next
      case Cons' : (Cons lh' lt')

      obtain lh'k lh'v where Lh' : "lh' = (lh'k, lh'v)"
        by(cases lh'; auto)

      have Lt : "lhk < lh'k"
        using strict_order_unfold[OF Cons.prems(1), of 1 0]
        using Lh Cons' Lh'
        by(auto)

      show ?thesis
        using Cons' Lh' Lt
        by(auto)
    qed

    show ?case using Cons.prems Lh Cons.IH[OF Ord_tl] Flip_update Conc'
      by(auto)
  qed
qed

lemma strict_order_oalist_keys :
  fixes l :: "('k :: linorder, 'v) oalist"
  shows "strict_order (oalist_keys l)"
  by(transfer; auto)

lemma strict_order_unique_set :
  assumes "strict_order l1"
  assumes "strict_order l2"
  assumes "set l1 = set l2"
  shows "l1 = l2"
  using assms
proof(induction l1 arbitrary: l2)
  case Nil
  then show ?case
    by(auto)
next
  case Cons1 : (Cons h1 t1)

  obtain h2 t2 where Cons2 : "l2 = h2 # t2"
    using Cons1
    by(cases l2; auto)

  have Ord_tl1 : "strict_order t1"
    using strict_order_tl Cons1.prems
    by auto

  have Ord_tl2 : "strict_order t2"
    using strict_order_tl Cons1.prems Cons2
    by auto

  have Dist1 : "distinct (h1 # t1)"
    using strict_order_distinct[of "h1 # t1"] Cons1.prems
    by auto

  have Dist2 : "distinct (h2 # t2)"
    using strict_order_distinct[of "h2 # t2"] Cons1.prems Cons2
    by auto

  show ?case
  proof(cases "h1 = h2")
    case True

    have Set_eq_tl : "set t1 = set t2"
      using Cons1.prems Cons2 True Dist1 Dist2
      by(auto)

    show ?thesis
      using Cons1.prems Cons2 True
      using Cons1.IH[OF Ord_tl1 Ord_tl2 Set_eq_tl]
      by(simp)
  next
    case Neq : False

    have Sets_eq : "insert h1 (set t1) = insert h2 (set t2)"
      using Cons1.prems Cons2
      by(simp)

    have H1_in2 : "h1 \<in> set t2"
      using Sets_eq Neq Dist1
      by(auto)

    have H2_in1 : "h2 \<in> set t1"
      using Sets_eq Neq Dist2
      by(auto)

    show ?thesis
    proof(cases "h1 < h2")
      case Lt : True

      obtain ix where Ix : "t2 ! ix = h1" "ix < length t2"
        using H1_in2
        unfolding in_set_conv_nth
        by auto

      have Bad : "h2 < h1"
        using strict_order_unfold[OF Cons1.prems(2), of "1 + ix" 0]
          Ix Cons1.prems Cons2
        by(auto)

      then have False using Lt by auto

      then show ?thesis by auto
    next

      case Gt' : False

      have Gt : "h2 < h1"
        using Neq Gt'
        by auto

      obtain ix where Ix : "t1 ! ix = h2" "ix < length t1"
        using H2_in1
        unfolding in_set_conv_nth
        by auto

      have Bad : "h1 < h2"
        using strict_order_unfold[OF Cons1.prems(1), of "1 + ix" 0]
          Ix Cons1.prems Cons2
        by(auto)

      then have False using Gt by auto

      then show ?thesis by auto
    qed
  qed
qed

lemma oacons_impl_of :
  fixes l :: "('k :: linorder, 'v) oalist"
  assumes "oacons hk hv t = Some l"
  shows "impl_of l = (hk, hv) # (impl_of t)"
  using assms
proof(transfer)
  fix t :: "('k * 'v) list"
  fix hk hv l
  show "strict_order (map fst t) \<Longrightarrow>
       strict_order (map fst l) \<Longrightarrow>
       oacons' hk hv t = Some l \<Longrightarrow>
       l = (hk, hv) # t"
    by(cases t; auto split: if_splits)
qed

lemma oacons_update :
  fixes l :: "('k :: linorder, 'v) oalist"
  assumes "oacons hk hv t = Some l"
  shows "update hk hv t = l"
  using assms
proof(transfer)
  fix hk hv
  fix t l :: "('k * 'v) list"

  assume Ord1 : "strict_order (map fst t)"
  assume Ord2 : "strict_order (map fst l)"
  assume Oacons : "oacons' hk hv t = Some l"
  show "str_ord_update hk hv t = l"
  proof(cases t)
    case Nil
    then show ?thesis
      using Oacons
      by auto
  next
    case (Cons lh' lt)

    obtain lh'k lh'v where Lh' :
      "lh' = (lh'k, lh'v)"
      by(cases lh'; auto)

    show ?thesis using Cons Oacons Lh'
      by(auto)
  qed
qed

lemma to_oalist_impl_of :
  fixes l :: "('k :: linorder, 'v) oalist"
  assumes "l' = impl_of l"
  shows "to_oalist l' = l"
  using assms
proof(induction l' arbitrary: l)
  case Nil
  then show ?case
    by(clarsimp;transfer; auto)
next
  case (Cons l'h l't)

  obtain l'hk l'hv where L'h :
    "l'h = (l'hk, l'hv)"
    by(cases l'h; auto)

  consider (1) "l = empty"
    | (2) lhk lhv lt where
      "oacons lhk lhv lt = Some l"
    using oalist_cases[of l]
    by auto
  then show ?case
  proof cases
    case 1

    have "l'h # l't = impl_of Oalist.empty"
      using Cons 1 by auto

    then have False
      by (transfer; auto)

    then show ?thesis by auto
  next
    case 2

    have Eqs :
      "l'hk = lhk" "l'hv = lhv" "l't = impl_of lt"
      using oacons_impl_of[OF 2] Cons.prems L'h
      by(auto)

    have L_unfold : "(lhk, lhv) # impl_of lt = impl_of l"
      using Cons.prems L'h Cons.IH[OF Eqs(3)] Eqs
      by(auto)

    have Conc' : "update lhk lhv lt = l"
      using oacons_update[OF 2]
      by auto

    show ?thesis using Cons.prems L'h Cons.IH[OF Eqs(3)]
        sym[OF L_unfold] Conc'
      by(auto)
  qed
qed

end