如何提升与有限图的传递关系?

时间:2018-12-02 13:07:10

标签: isabelle

我试图证明有限图元素上的传递关系等同于有限图本身上的传递关系。

这是一个辅助引理,它表明如果有限元素上的关系是可传递的,则有限映射上的关系是可传递的:

lemma fmrel_trans:
  "(⋀x y z. x ∈ fmran' xm ⟹ P x y ⟹ Q y z ⟹ R x z) ⟹
   fmrel P xm ym ⟹ fmrel Q ym zm ⟹ fmrel R xm zm"
  unfolding fmrel_iff
  by (metis fmdomE fmdom_notD fmran'I option.rel_inject(2) option.rel_sel)

这是第一个引理,我已成功证明:

lemma trancl_to_fmrel:
  "(fmrel f)⇧+⇧+ xm ym ⟹ fmrel f⇧+⇧+ xm ym"
  apply (induct rule: tranclp_induct)
  apply (simp add: fmap.rel_mono_strong)
  apply (rule_tac ?P="f⇧+⇧+" and ?Q="f" and ?ym="y" in fmrel_trans; auto)
  done

这是一个对称引理,我无法证明:

lemma fmrel_to_trancl:
  "fmrel r⇧+⇧+ xm ym ⟹
   (⋀x. r x x) ⟹
   (fmrel r)⇧+⇧+ xm ym"

等效地,这个引理可以表示为

lemma fmrel_tranclp_induct:
  "fmrel r⇧+⇧+ a b ⟹
   (⋀x. r x x) ⟹
   (⋀y. fmrel r a y ⟹ P y) ⟹
   (⋀y z. fmrel r⇧+⇧+ a y ⟹ fmrel r y z ⟹ P y ⟹ P z) ⟹ P b"

lemma fmrel_tranclp_trans_induct:
  "fmrel r⇧+⇧+ a b ⟹
   (⋀x. r x x) ⟹
   (⋀x y. fmrel r x y ⟹ P x y) ⟹
   (⋀x y z. fmrel r⇧+⇧+ x y ⟹ P x y ⟹ fmrel r⇧+⇧+ y z ⟹ P y z ⟹ P x z) ⟹ P a b"

证明这三个引理中的任何一个,我都可以证明其余的。

该问题与How to lift a transitive relation from elements to lists?非常相似,但是该问题的证明基于归纳规则list_all2_induct。我找不到fmrel的类似规则。我试图证明这样的事情,但没有成功:

lemma fmrel_induct
  [consumes 1, case_names Nil Cons, induct set: fmrel]:
  assumes P: "fmrel P xs ys"
  assumes Nil: "R fmempty fmempty"
  assumes Cons: "⋀k x xs y ys.
    ⟦P x y; fmrel P xs ys; fmlookup xs k = None; fmlookup ys k = None; R xs ys⟧ ⟹
    R (fmupd k x xs) (fmupd k y ys)"
  shows "R xs ys"

在引理中,我也尝试用fmrel替换list_all2,但没有成功:

lemma fmrel_to_list_all2:
  "fmrel f xm ym ⟹
   xs = map snd (sorted_list_of_fmap xm) ⟹
   ys = map snd (sorted_list_of_fmap ym) ⟹
   list_all2 f xs ys"

想法是xmym的键(域)相等。在地图的排序值(范围)上,fmrel等效于list_all2

您能帮我证明fmrel_to_trancl吗?

1 个答案:

答案 0 :(得分:2)

更新

这个问题以及我在该网站上回答的一些先前问题促使我开始在独立的图书馆中收集有关listalistfmap的更多结果。该工作是在GitHub repository的上下文中完成的。存储库包含此答案中的所有定理。这些定理可以在理论Quotient_FMap中找到。

我以前的答案(以更新的形式)中的其他几个定理也可以在存储库中找到。希望该存储库包含有关上述类型的其他有用结果。


原始答案(包括小的修订)可以在下面(旧版)中找到。但是,重要的是要注意,答案包含几种不良的Isabelle编码做法。

theory so_htlartfm
imports 
  Complex_Main
  "HOL-Library.Finite_Map"
begin


lemma fmap_eqdom_Cons1:
  assumes as_1: "fmlookup xm i = None"
    and as_2: "fmrel R (fmupd i x xm) ym" 
  shows 
    "(∃z zm. 
    fmlookup zm i = None ∧ ym = (fmupd i z zm) ∧ R x z ∧ fmrel R xm zm)"
proof - 
  from as_2 have eq_dom: "fmdom (fmupd i x xm) = fmdom ym" 
    using fmrel_fmdom_eq by blast
  from as_1 eq_dom as_2 obtain y where y: "fmlookup ym i = Some y"
    by force
  obtain z zm where z_zm: "ym = (fmupd i z zm) ∧ fmlookup zm i = None"
    using y by (smt fmap_ext fmlookup_drop fmupd_lookup)
  {
    assume "¬R x z"
    with as_1 z_zm have "¬fmrel R (fmupd i x xm) ym"
      by (metis fmrel_iff fmupd_lookup option.simps(11))
  }
  with as_2 have c3: "R x z" by auto
  {
    assume "¬fmrel R xm zm"
    with as_1 have "¬fmrel R (fmupd i x xm) ym" 
      by (metis fmrel_iff fmupd_lookup option.rel_sel z_zm)
  }
  with as_2 have c4: "fmrel R xm zm" by auto
  from z_zm c3 c4 show ?thesis by auto
qed

lemma fmap_eqdom_induct [consumes 1, case_names nil step]:
  assumes R: "fmrel R xm ym"
    and nil: "P fmempty fmempty"
    and step: 
    "⋀x xm y ym i. ⟦R x y; fmrel R xm ym; P xm ym⟧ ⟹ 
    P (fmupd i x xm) (fmupd i y ym)"
  shows "P xm ym"
  using R 
proof(induct xm arbitrary: ym)
  case fmempty
  then show ?case
    by (metis fempty_iff fmdom_empty fmfilter_alt_defs(5) 
      fmfilter_false fmrel_fmdom_eq fmrestrict_fset_dom nil)
next
  case (fmupd i x xm) show ?case 
  proof -
    from fmupd.prems(1) obtain y where y: "fmlookup ym i = Some y"
      by (metis fmupd.prems(1) fmrel_cases fmupd_lookup option.discI)
    from fmupd.hyps(2) fmupd.prems(1) fmupd.prems(1) obtain z zm where 
      zm_i_none: "fmlookup zm i = None" and
      ym_eq_z_zm: "ym = (fmupd i z zm)" and 
      R_x_z: "R x z" and
      R_xm_zm: "fmrel R xm zm"
      using fmap_eqdom_Cons1 by metis
    with R_xm_zm fmupd.hyps(1) have P_xm_zm: "P xm zm" by blast
    from R_x_z R_xm_zm P_xm_zm have "P (fmupd i x xm) (fmupd i z zm)" 
      by (rule step)
    then show ?thesis by (simp add: ym_eq_z_zm)
  qed
qed

lemma fmrel_to_rtrancl:
  assumes as_r: "(⋀x. r x x)" 
    and rel_rpp_xm_ym: "(fmrel r⇧*⇧*) xm ym" 
  shows "(fmrel r)⇧*⇧* xm ym"
proof-
  from rel_rpp_xm_ym show "(fmrel r)⇧*⇧* xm ym"
  proof(induct rule: fmap_eqdom_induct)
    case nil then show ?case by auto
  next
    case (step x xm y ym i) show ?case
    proof -
      from as_r have lp_xs_xs: "fmrel r xm xm" by (simp add: fmap.rel_refl)
      from step.hyps(1) have x_xs_y_zs: 
        "(fmrel r)⇧*⇧* (fmupd i x xm) (fmupd i y xm)"
      proof(induction rule: rtranclp_induct)
        case base then show ?case by simp
      next
        case (step y z) then show ?case 
        proof -
          have rt_step_2: "(fmrel r)⇧*⇧* (fmupd i y xm) (fmupd i z xm)" 
            by (rule r_into_rtranclp, simp add: fmrel_upd lp_xs_xs step.hyps(2))
          from step.IH rt_step_2 show ?thesis by (rule rtranclp_trans) 
        qed      
      qed
      from step.hyps(3) have "(fmrel r)⇧*⇧* (fmupd i y xm) (fmupd i y ym)"
      proof(induction rule: rtranclp_induct)
        case base then show ?case by simp
      next
        case (step ya za) show ?case
        proof -
          have rt_step_2: "(fmrel r)⇧*⇧* (fmupd i y ya) (fmupd i y za)" 
            by (rule r_into_rtranclp, simp add: as_r fmrel_upd step.hyps(2)) 
          from step.IH rt_step_2 show ?thesis by (rule rtranclp_trans)
        qed
      qed
      with x_xs_y_zs show ?thesis by simp
    qed
  qed
qed

lemma fmrel_to_trancl:
  assumes as_r: "(⋀x. r x x)" 
    and rel_rpp_xm_ym: "(fmrel r⇧+⇧+) xm ym" 
  shows "(fmrel r)⇧+⇧+ xm ym" 
  by (metis as_r fmrel_to_rtrancl fmap.rel_mono_strong fmap.rel_refl 
      r_into_rtranclp reflclp_tranclp rel_rpp_xm_ym rtranclpD rtranclp_idemp 
      rtranclp_reflclp tranclp.r_into_trancl)

end