src/HOL/Library/SCT_Definition.thy
author haftmann
Mon, 26 Mar 2007 14:53:02 +0200
changeset 22519 eb70ed79dac7
parent 22371 c9f5895972b0
child 22665 cf152ff55d16
permissions -rw-r--r--
importing Eval theory
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
22371
c9f5895972b0 added headers
krauss
parents: 22359
diff changeset
     1
(*  Title:      HOL/Library/SCT_Definition.thy
c9f5895972b0 added headers
krauss
parents: 22359
diff changeset
     2
    ID:         $Id$
c9f5895972b0 added headers
krauss
parents: 22359
diff changeset
     3
    Author:     Alexander Krauss, TU Muenchen
c9f5895972b0 added headers
krauss
parents: 22359
diff changeset
     4
*)
c9f5895972b0 added headers
krauss
parents: 22359
diff changeset
     5
22359
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     6
theory SCT_Definition
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     7
imports Graphs Infinite_Set
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     8
begin
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
     9
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    10
section {* Size-Change Graphs *}
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    11
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    12
datatype sedge =
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    13
  LESS ("\<down>")
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    14
  | LEQ ("\<Down>")
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    15
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    16
instance sedge :: times ..
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    17
instance sedge :: one ..
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    18
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    19
defs (overloaded)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    20
  one_sedge_def: "1 == \<Down>"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    21
  mult_sedge_def:" a * b == (if a = \<down> then \<down> else b)"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    22
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    23
instance sedge :: comm_monoid_mult
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    24
proof
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    25
  fix a b c :: sedge
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    26
  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
    27
  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
    28
  show "a * b = b * a" unfolding mult_sedge_def
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    29
    by (cases a, simp) (cases b, auto)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    30
qed
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    31
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    32
instance sedge :: finite
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    33
proof
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    34
  have a: "UNIV = { LESS, LEQ }"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    35
    by auto (case_tac x, auto) (* FIXME *)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    36
  show "finite (UNIV::sedge set)"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    37
    by (simp add:a)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    38
qed
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
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    41
types scg = "(nat, sedge) graph"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    42
types acg = "(nat, scg) graph"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    43
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
section {* Size-Change Termination *}
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    46
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    47
abbreviation (input)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    48
  "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
    49
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    50
abbreviation (input)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    51
  "dsc G i j \<equiv> has_edge G i LESS j"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    52
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    53
abbreviation (input)
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    54
  "eq G i j \<equiv> has_edge G i LEQ j"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    55
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    56
abbreviation
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    57
  eql :: "scg \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    58
("_ \<turnstile> _ \<leadsto> _")
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
  "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
    61
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    62
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    63
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
    64
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    65
  "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
    66
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    67
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
    68
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    69
  "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
    70
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
abbreviation eqlat :: "(nat, scg) ipath \<Rightarrow> nat sequence \<Rightarrow> nat \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    73
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    74
  "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
    75
                  \<or> has_edge (snd (p i)) (\<theta> i) LEQ (\<theta> (Suc 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
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    78
definition is_desc_thread :: "nat sequence \<Rightarrow> (nat, scg) ipath \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    79
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    80
  "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
    81
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    82
definition SCT :: "acg \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    83
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    84
  "SCT \<A> = 
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    85
  (\<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
    86
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    87
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    88
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    89
definition no_bad_graphs :: "acg \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    90
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    91
  "no_bad_graphs A = 
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    92
  (\<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
    93
  \<longrightarrow> (\<exists>p. has_edge G p LESS p))"
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
definition SCT' :: "acg \<Rightarrow> bool"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    97
where
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    98
  "SCT' A = no_bad_graphs (tcl A)"
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
    99
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
   100
94a794672c8b Added formalization of size-change principle (experimental).
krauss
parents:
diff changeset
   101
end