Theory Maps
section ‹Maps›
theory Maps
imports Sequence_Zip
begin
  section ‹Basics›
  lemma fun_upd_None[simp]:
    assumes "p ∉ dom f"
    shows "f (p := None) = f"
    using assms by auto
  
  lemma finite_set_of_finite_maps':
    assumes "finite A" "finite B"
    shows "finite {m. dom m ⊆ A ∧ ran m ⊆ B}"
  proof -
    have "{m. dom m ⊆ A ∧ ran m ⊆ B} = (⋃ 𝒜 ∈ Pow A. {m. dom m = 𝒜 ∧ ran m ⊆ B})" by auto
    also have "finite …" using finite_subset assms by (auto intro: finite_set_of_finite_maps)
    finally show ?thesis by this
  qed
  lemma fold_map_of:
    assumes "distinct xs"
    shows "fold (λ x (k, m). (Suc k, m (x ↦ k))) xs (k, m) =
      (k + length xs, m ++ map_of (xs || [k ..< k + length xs]))"
  using assms
  proof (induct xs arbitrary: k m)
    case Nil
    show ?case by simp
  next
    case (Cons x xs)
    have "fold (λ x (k, m). (Suc k, m (x ↦ k))) (x # xs) (k, m) =
      (Suc k + length xs, (m ++ map_of (xs || [Suc k ..< Suc k + length xs])) (x ↦ k))"
      using Cons by (fastforce simp add: map_add_upd_left)
    also have "… = (k + length (x # xs), m ++ map_of (x # xs || [k ..< k + length (x # xs)]))"
      by (simp add: upt_rec)
    finally show ?case by this
  qed
  subsection ‹Expanding set functions to sets of functions›
  definition expand :: "('a ⇒ 'b set) ⇒ ('a ⇒ 'b) set" where
    "expand f = {g. ∀ x. g x ∈ f x}"
  lemma expand_update[simp]:
    assumes "f x ≠ {}"
    shows "expand (f (x := S)) = (⋃ y ∈ S. (λ g. g (x := y)) ` expand f)"
  unfolding expand_def
  proof (intro equalityI subsetI)
    fix g
    assume 1: "g ∈ {g. ∀ y. g y ∈ (f (x := S)) y}"
    have 2: "g x ∈ S" "⋀ y. x ≠ y ⟹ g y ∈ f y" using 1 by (auto split: if_splits)
    obtain y where 3: "y ∈ f x" using assms by auto
    show "g ∈ (⋃ y ∈ S. (λ g. g (x := y)) ` {g. ∀ x. g x ∈ f x})"
    proof (intro UN_I image_eqI)
      show "g x ∈ S" using 2(1) by this
      show "g (x := y) ∈ {g. ∀ x. g x ∈ f x}" using 2 3 by auto
      show "g = g (x := y, x := g x)" by simp
    qed
  next
    fix g
    assume 1: "g ∈ (⋃ y ∈ S. (λ g. g (x := y)) ` {g. ∀ x. g x ∈ f x})"
    show "g ∈ {g. ∀ y. g y ∈ (f (x := S)) y}" using 1 by auto
  qed
  subsection ‹Expanding set maps into sets of maps›
  definition expand_map :: "('a ⇀ 'b set) ⇒ ('a ⇀ 'b) set" where
    "expand_map f ≡ expand (case_option {None} (image Some) ∘ f)"
  lemma expand_map_alt_def: "expand_map f =
    {g. dom g = dom f ∧ (∀ x S y. f x = Some S ⟶ g x = Some y ⟶ y ∈ S)}"
    unfolding expand_map_def expand_def by (auto split: option.splits) (force+)
  lemma expand_map_dom:
    assumes "g ∈ expand_map f"
    shows "dom g = dom f"
    using assms unfolding expand_map_def expand_def by (auto split: option.splits)
  lemma expand_map_empty[simp]: "expand_map Map.empty = {Map.empty}" unfolding expand_map_def expand_def by auto
  lemma expand_map_update[simp]:
    "expand_map (f (x ↦ S)) = (⋃ y ∈ S. (λ g. g (x ↦ y)) ` expand_map (f (x := None)))"
  proof -
    let ?m = "case_option {None} (image Some)"
    have 1: "((?m ∘ f) (x := {None})) x ≠ {}" by simp
    have "expand_map (f (x := Some S)) = expand_map (f (x := None, x := Some S))" by simp
    also have "… = expand ((?m ∘ f) (x := {None}, x := ?m (Some S)))"
      unfolding expand_map_def fun_upd_comp by simp
    also have "… = (⋃ y ∈ ?m (Some S). (λ g. g (x := y)) ` expand ((?m ∘ f) (x := {None})))"
      using expand_update 1 by this
    also have "… = (⋃ y ∈ S. (λ g. g (x ↦ y)) ` expand_map (f (x := None)))"
      unfolding expand_map_def fun_upd_comp by simp
    finally show ?thesis by this
  qed
end