src/HOL/Library/SCT_Definition.thy
author krauss
Mon, 26 Feb 2007 21:34:16 +0100
changeset 22359 94a794672c8b
child 22371 c9f5895972b0
permissions -rw-r--r--
Added formalization of size-change principle (experimental).
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
22359
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     1
theory SCT_Definition
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     2
imports Graphs Infinite_Set
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     3
begin
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     4
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     5
section {* Size-Change Graphs *}
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     6
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     7
datatype sedge =
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     8
  LESS ("\<down>")
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     9
  | LEQ ("\<Down>")
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    10
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    11
instance sedge :: times ..
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    12
instance sedge :: one ..
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    13
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    14
defs (overloaded)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    15
  one_sedge_def: "1 == \<Down>"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    16
  mult_sedge_def:" a * b == (if a = \<down> then \<down> else b)"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    17
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    18
instance sedge :: comm_monoid_mult
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    19
proof
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    20
  fix a b c :: sedge
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    21
  show "a * b * c = a * (b * c)" by (simp add:mult_sedge_def)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    22
  show "1 * a = a" by (simp add:mult_sedge_def one_sedge_def)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    23
  show "a * b = b * a" unfolding mult_sedge_def
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    24
    by (cases a, simp) (cases b, auto)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    25
qed
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    26
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    27
instance sedge :: finite
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    28
proof
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    29
  have a: "UNIV = { LESS, LEQ }"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    30
    by auto (case_tac x, auto) (* FIXME *)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    31
  show "finite (UNIV::sedge set)"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    32
    by (simp add:a)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    33
qed
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    34
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    35
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    36
types scg = "(nat, sedge) graph"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    37
types acg = "(nat, scg) graph"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    38
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    39
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    40
section {* Size-Change Termination *}
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    41
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    42
abbreviation (input)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    43
  "desc P Q == ((\<exists>n.\<forall>i\<ge>n. P i) \<and> (\<exists>\<^sub>\<infinity>i. Q i))"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    44
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    45
abbreviation (input)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    46
  "dsc G i j \<equiv> has_edge G i LESS j"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    47
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    48
abbreviation (input)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    49
  "eq G i j \<equiv> has_edge G i LEQ j"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    50
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    51
abbreviation
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    52
  eql :: "scg \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    53
("_ \<turnstile> _ \<leadsto> _")
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    54
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    55
  "eql G i j \<equiv> has_edge G i LESS j \<or> has_edge G i LEQ j"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    56
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    57
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    58
abbreviation (input) descat :: "(nat, scg) ipath \<Rightarrow> nat sequence \<Rightarrow> nat \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    59
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    60
  "descat p \<theta> i \<equiv> has_edge (snd (p i)) (\<theta> i) LESS (\<theta> (Suc i))"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    61
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    62
abbreviation (input) eqat :: "(nat, scg) ipath \<Rightarrow> nat sequence \<Rightarrow> nat \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    63
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    64
  "eqat p \<theta> i \<equiv> has_edge (snd (p i)) (\<theta> i) LEQ (\<theta> (Suc i))"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    65
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    66
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    67
abbreviation eqlat :: "(nat, scg) ipath \<Rightarrow> nat sequence \<Rightarrow> nat \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    68
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    69
  "eqlat p \<theta> i \<equiv> (has_edge (snd (p i)) (\<theta> i) LESS (\<theta> (Suc i))
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    70
                  \<or> has_edge (snd (p i)) (\<theta> i) LEQ (\<theta> (Suc i)))"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    71
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    72
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    73
definition is_desc_thread :: "nat sequence \<Rightarrow> (nat, scg) ipath \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    74
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    75
  "is_desc_thread \<theta> p = ((\<exists>n.\<forall>i\<ge>n. eqlat p \<theta> i) \<and> (\<exists>\<^sub>\<infinity>i. descat p \<theta> i))" 
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    76
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    77
definition SCT :: "acg \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    78
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    79
  "SCT \<A> = 
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    80
  (\<forall>p. has_ipath \<A> p \<longrightarrow> (\<exists>\<theta>. is_desc_thread \<theta> p))"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    81
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    82
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    83
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    84
definition no_bad_graphs :: "acg \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    85
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    86
  "no_bad_graphs A = 
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    87
  (\<forall>n G. has_edge A n G n \<and> G * G = G
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    88
  \<longrightarrow> (\<exists>p. has_edge G p LESS p))"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    89
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    90
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    91
definition SCT' :: "acg \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    92
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    93
  "SCT' A = no_bad_graphs (tcl A)"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    94
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    95
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    96
end