Theory CoUnit

theory CoUnit
imports Main
(*  Title:      ZF/ex/CoUnit.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge

section {* Trivial codatatype definitions, one of which goes wrong! *}

theory CoUnit imports Main begin

text {*
  See discussion in: L C Paulson.  A Concrete Final Coalgebra Theorem
  for ZF Set Theory.  Report 334, Cambridge University Computer
  Laboratory.  1994.


  This degenerate definition does not work well because the one
  constructor's definition is trivial!  The same thing occurs with
  Aczel's Special Final Coalgebra Theorem.

  counit :: i
  "counit" = Con ("x ∈ counit")

inductive_cases ConE: "Con(x) ∈ counit"
  -- {* USELESS because folding on @{term "Con(xa) == xa"} fails. *}

lemma Con_iff: "Con(x) = Con(y) <-> x = y"
  -- {* Proving freeness results. *}
  by (auto elim!: counit.free_elims)

lemma counit_eq_univ: "counit = quniv(0)"
  -- {* Should be a singleton, not everything! *}
  apply (rule counit.dom_subset [THEN equalityI])
  apply (rule subsetI)
  apply (erule counit.coinduct)
   apply (rule subset_refl)
  apply (unfold counit.con_defs)
  apply fast

text {*
  \medskip A similar example, but the constructor is non-degenerate
  and it works!  The resulting set is a singleton.

  counit2 :: i
  "counit2" = Con2 ("x ∈ counit2", "y ∈ counit2")

inductive_cases Con2E: "Con2(x, y) ∈ counit2"

lemma Con2_iff: "Con2(x, y) = Con2(x', y') <-> x = x' & y = y'"
  -- {* Proving freeness results. *}
  by (fast elim!: counit2.free_elims)

lemma Con2_bnd_mono: "bnd_mono(univ(0), %x. Con2(x, x))"
  apply (unfold counit2.con_defs)
  apply (rule bnd_monoI)
   apply (assumption | rule subset_refl QPair_subset_univ QPair_mono)+

lemma lfp_Con2_in_counit2: "lfp(univ(0), %x. Con2(x,x)) ∈ counit2"
  apply (rule singletonI [THEN counit2.coinduct])
  apply (rule qunivI [THEN singleton_subsetI])
  apply (rule subset_trans [OF lfp_subset empty_subsetI [THEN univ_mono]])
  apply (fast intro!: Con2_bnd_mono [THEN lfp_unfold])

lemma counit2_Int_Vset_subset [rule_format]:
  "Ord(i) ==> ∀x y. x ∈ counit2 --> y ∈ counit2 --> x ∩ Vset(i) ⊆ y"
  -- {* Lemma for proving finality. *}
  apply (erule trans_induct)
  apply (tactic "safe_tac (put_claset subset_cs @{context})")
  apply (erule counit2.cases)
  apply (erule counit2.cases)
  apply (unfold counit2.con_defs)
  apply (tactic {* fast_tac (put_claset subset_cs @{context}
    addSIs [@{thm QPair_Int_Vset_subset_UN} RS @{thm subset_trans}, @{thm QPair_mono}]
    addSEs [@{thm Ord_in_Ord}, @{thm Pair_inject}]) 1 *})

lemma counit2_implies_equal: "[| x ∈ counit2;  y ∈ counit2 |] ==> x = y"
  apply (rule equalityI)
  apply (assumption | rule conjI counit2_Int_Vset_subset [THEN Int_Vset_subset])+

lemma counit2_eq_univ: "counit2 = {lfp(univ(0), %x. Con2(x,x))}"
  apply (rule equalityI)
   apply (rule_tac [2] lfp_Con2_in_counit2 [THEN singleton_subsetI])
  apply (rule subsetI)
  apply (drule lfp_Con2_in_counit2 [THEN counit2_implies_equal])
  apply (erule subst)
  apply (rule singletonI)