author | berghofe |
Wed, 11 Jul 2007 11:28:13 +0200 | |
changeset 23755 | 1c4672d130b1 |
parent 23416 | b73a6b72f706 |
permissions | -rw-r--r-- |
22371 | 1 |
(* Title: HOL/Library/SCT_Examples.thy |
2 |
ID: $Id$ |
|
3 |
Author: Alexander Krauss, TU Muenchen |
|
4 |
*) |
|
5 |
||
23416
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
6 |
header {* Examples for Size-Change Termination *} |
22665 | 7 |
|
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
8 |
theory SCT_Examples |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
9 |
imports Size_Change_Termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
10 |
begin |
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 |
function f :: "nat \<Rightarrow> nat \<Rightarrow> nat" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
13 |
where |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
14 |
"f n 0 = n" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
15 |
| "f 0 (Suc m) = f (Suc m) m" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
16 |
| "f (Suc n) (Suc m) = f m n" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
17 |
by pat_completeness auto |
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 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
20 |
termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
21 |
unfolding f_rel_def lfp_const |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
22 |
apply (rule SCT_on_relations) |
22375 | 23 |
apply (tactic "Sct.abs_rel_tac") (* Build call descriptors *) |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
24 |
apply (rule ext, rule ext, simp) (* Show that they are correct *) |
22375 | 25 |
apply (tactic "Sct.mk_call_graph") (* Build control graph *) |
23416
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
26 |
apply (rule SCT_Main) (* Apply main theorem *) |
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
27 |
apply (simp add:finite_acg_simps) (* show finiteness *) |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
28 |
by eval (* Evaluate to true *) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
29 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
30 |
function p :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
31 |
where |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
32 |
"p m n r = (if r>0 then p m (r - 1) n else |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
33 |
if n>0 then p r (n - 1) m |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
34 |
else m)" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
35 |
by pat_completeness auto |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
36 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
37 |
termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
38 |
unfolding p_rel_def lfp_const |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
39 |
apply (rule SCT_on_relations) |
22375 | 40 |
apply (tactic "Sct.abs_rel_tac") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
41 |
apply (rule ext, rule ext, simp) |
22375 | 42 |
apply (tactic "Sct.mk_call_graph") |
23416
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
43 |
apply (rule SCT_Main) |
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
44 |
apply (simp add:finite_acg_ins finite_acg_empty finite_graph_def) (* show finiteness *) |
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
45 |
by eval |
22359
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 |
function foo :: "bool \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
48 |
where |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
49 |
"foo True (Suc n) m = foo True n (Suc m)" |
22492 | 50 |
| "foo True 0 m = foo False 0 m" |
51 |
| "foo False n (Suc m) = foo False (Suc n) m" |
|
52 |
| "foo False n 0 = n" |
|
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
53 |
by pat_completeness auto |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
54 |
|
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
55 |
termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
56 |
unfolding foo_rel_def lfp_const |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
57 |
apply (rule SCT_on_relations) |
22375 | 58 |
apply (tactic "Sct.abs_rel_tac") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
59 |
apply (rule ext, rule ext, simp) |
22375 | 60 |
apply (tactic "Sct.mk_call_graph") |
23416
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
61 |
apply (rule SCT_Main) |
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
62 |
apply (simp add:finite_acg_ins finite_acg_empty finite_graph_def) (* show finiteness *) |
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
63 |
by eval |
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
64 |
|
22359
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 |
function (sequential) |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
67 |
bar :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" |
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 |
"bar 0 (Suc n) m = bar m m m" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
70 |
| "bar k n m = 0" |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
71 |
by pat_completeness auto |
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 |
termination |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
74 |
unfolding bar_rel_def lfp_const |
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
75 |
apply (rule SCT_on_relations) |
22375 | 76 |
apply (tactic "Sct.abs_rel_tac") |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
77 |
apply (rule ext, rule ext, simp) |
22375 | 78 |
apply (tactic "Sct.mk_call_graph") |
23416
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
79 |
apply (rule SCT_Main) |
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
80 |
apply (simp add:finite_acg_ins finite_acg_empty finite_graph_def) (* show finiteness *) |
b73a6b72f706
generalized proofs so that call graphs can have any node type.
krauss
parents:
23374
diff
changeset
|
81 |
by (simp only:sctTest_simps cong: sctTest_congs) |
22359
94a794672c8b
Added formalization of size-change principle (experimental).
krauss
parents:
diff
changeset
|
82 |
|
22371 | 83 |
end |